package pv3;

# vim: set syntax=on filetype=perl:ts=4:sw=4

# Originally this series of utilities were written
# to make use of gdiffdeleta. However since that
# only works on 32bit environments, becoming more of
# a limitation! Hence the utilities can now make
# use of Xdiff binaries or ideally the Diff::LibXDiff
# perl module if available.

# To cater for files where several mechanisms are
# available we must have a way of differentiating
# between the types. We do this be prepending XDIFF:
# or XDIFFLIB: if either of those are used, otherwise
# it will be thought to be a gdiffdelta difference.
#
# V2 was a versioning file per file, but v3 is a versioning
# file per directroy (in the .pv3 or .PV3 sub-directory, or
# in the ,pv3 local file.

use strict;
use English;
use DBI;
use Digest::SHA1 qw(sha1_hex);
use Compress::Zlib;
use MIME::Base64;
use Data::Dumper;
use File::Basename;
use Time::HiRes qw(time);
use Fcntl;
use POSIX qw(mktime);
use File::Temp qw(tempfile);
use File::Spec;
use strict;

my $PV3_DEBUG=0;
my $PV3_FILE_VERSION=3;

BEGIN {
	use Config;
	$::PV3_TEXTDIFF=0;
	$::PV3_XDIFF=undef;
	$::PV3_XDIFFLIB=0;
	$::PV3_GDIFFLIB=0;
	$::PV3_ZLIB=1; # Always available
	if(exists($::ENV{PV3_XDIFF})) {
		if(! -x $::ENV{PV3_XDIFF}) {
			print STDERR "PV3_XDIFF set and '$::ENV{PV3_XDIFF}' does not exist or is not executable.\n";
			exit(1);
		}
		$::PV3_XDIFF=$::ENV{PV3_XDIFF};
	}
	eval 'use Algorithm::GDiffDelta qw(gdiff_delta gdiff_apply);';
	if(! $@) {
		$::PV3_GDIFFLIB=1;
		eval 'use gdiff_string;';
	}
	eval 'use Diff::LibXDiff 0.0.5;';
	if(! $@) {
		$::PV3_XDIFFLIB=1;
	}
	$::PV_OS=$Config{osname};
	eval 'use Text::Diff ();';
	if(! $@) {
		$::PV3_TEXTDIFF=1;
	}
	if(exists($::ENV{PV3_DEBUG}) && $::ENV{PV3_DEBUG}) {
		$PV3_DEBUG=1;
	}
}

sub _copyfile($$) {
my ($sname,$dname)=@_;
my ($rfd,$wfd,$cdata,$csize,$fsize);
my (@sb,$togo,$toread,$aread);

	return(undef,"No such file: $sname") if ! -f $sname;
	return(undef,"Destination file exists: $dname") if -f $dname;
	@sb=stat($sname);
	if(!exists($sb[7])) {
		return(undef,"Unable to stat file $sname: $!");
	}
	sysopen($rfd,"$sname",O_RDONLY) or
		return(undef,"Unable to open file for reading: $sname");
	sysopen($wfd,"$dname",O_CREAT|O_WRONLY) or
		return(undef,"Unable to open file for writing: $dname");

	$csize=0;
	$togo=$sb[7]-$csize;
	while($togo) {
		$toread=$togo>10240 ? 10240 : $togo;
		$aread=sysread($rfd,$cdata,$toread);
		if(!defined($aread)) {
			unlink $dname;
			return(undef,"Error whilst reading from $sname.");
		}
		last if !$aread;
		$toread=syswrite($wfd,$cdata,$aread);
		if(!defined($toread) || $toread!=$aread) {
			unlink $dname;
			return(undef,"Error whilst writing to $sname.");
		}
		$togo-=$aread;
	}
	close($wfd);
	close($rfd);
	return($sb[7],undef);
}

sub _formats() {
	return($::PV3_TEXTDIFF,
	defined($::PV3_XDIFF),
	$::PV3_XDIFFLIB,
	$::PV3_GDIFFLIB,
	$::PV3_ZLIB=1);
}

sub _Getpwuid($) {
	if($::PV_OS !~ /mswin/io) {
		return getpwuid($>);
	}
	return $::ENV{USERNAME};
}

sub _exists($$$) {
my $dbh=shift;
my ($obj,$type)=@_;
my ($cmd,$rc,$sth);

	$type="table" if !defined($type);
	$cmd="SELECT * FROM SQLITE_MASTER WHERE type = '$type' AND name = '$obj';";
	my $h=$dbh->selectrow_hashref("$cmd");
	if(!defined($h)) {
		return 0;
	}
	return 1;
}

{
my $real_dbh=undef;

sub pv_disconnect {
my $dbh=shift;

	if(defined($real_dbh)) {
		# copy from memory to new ...	
		;
	}
	$real_dbh=undef;
}

sub pv_connect {
my @A=@_;

	printf("DEBUG: pv_connect called!\n") if $PV3_DEBUG;
	my $force_open=0;
	my $ar=$A[3];
	my $my_format=undef;
	if(exists($ar->{FORMAT})) {
		$my_format=$ar->{FORMAT};
		delete $ar->{FORMAT};
	}
	if(exists($ar->{force_open})) {
		$force_open=$ar->{force_open};
		delete $ar->{force_open};
	}

	my $file_version=3;
	my $s=$A[0];
	my $s2=$A[0];
	$s =~ s/^dbi:SQLite:/dbi:SQLite2:/;
	$A[0]=$s;
	my $dbh;
	eval {$dbh=DBI->connect(@A);};
	if(!$dbh) {
		$A[0]=$s2;
		eval {$dbh=DBI->connect(@A);};
	}
	return(undef,"Unable to open file.") if !defined($dbh);

	if(_exists($dbh,"format","table")) {
		my $res;
		{
			my $fmt=$dbh->selectrow_hashref("SELECT * FROM format;");
			if(!defined($fmt)) {
				$file_version=3;
				$file_version=$my_format if defined($my_format);
			} else {
				$file_version=$fmt->{version};
			}
		}
	} else {
		my $res=$dbh->do("CREATE TABLE versions(fileid INTEGER,nv INTEGER,author VARCHAR(10),date INTEGER,sha1 CHAR(40),tags VARCHAR(100),comment VARCHAR(50),data BLOB,osize INTEGER);");
		$res=$dbh->do("CREATE TABLE filemaps (fileid INTEGER PRIMARY KEY,filename CHAR(255));");
		$res=$dbh->do("CREATE INDEX filemaps_i ON filemaps (filename);");
		$res=$dbh->do("CREATE TABLE locks (fileid INTEGER PRIMARY KEY,nv INTEGER,sha1 CHAR(40),type CHAR(1),who VARCHAR(10),date INTEGER);");
		$res=$dbh->do("CREATE TABLE exts (fileid INTEGER,nv INTEGER,ext INTEGER,length INTEGER,data BLOB);");
		$res=$dbh->do("CREATE TABLE format (version INTEGER,ty INTEGER);");
		if(defined($my_format)) {
			$dbh->do("INSERT INTO format (version,ty) VALUES ('3','$my_format');");
		} else {
			if($::PV3_XDIFFLIB==1) {
				$dbh->do("INSERT INTO format (version,ty) VALUES ('3','2');");
			} elsif($::PV3_GDIFFLIB==1) {
				$dbh->do("INSERT INTO format (version,ty) VALUES ('3','1');");
			} elsif(defined($::PV3_XDIFF)) {
				$dbh->do("INSERT INTO format (version,ty) VALUES ('3','3');");
			} else {
				$dbh->do("INSERT INTO format (version,ty) VALUES ('3','4');");
			}
		}
		$dbh->commit();
	}
	if($file_version < $PV3_FILE_VERSION && $force_open==0) {
		return(undef,"PV3 file version too old - consider using pv3_upgrade on file");
	}
	$dbh->do("PRAGMA cache_size = 100000;");
	return($dbh,undef);
}

}

#########################################################################
# This will return an nv given a tag. The tag can be prefixed with	#
# TAG: or T: if necessary. It can include the '*' character to 		#
# perform pattern matching...						#
# SIZE:nn will match first of that size (original size, not change size.#
# AGE:nn (the oldest checkin after nn days ago)				#
# DATE:YYYYMMDD[-HHMMSS] - oldest check on that date/time or first 	#
# after it.								#
#########################################################################

{
my %cache=();

sub _cache_versions_info($) {
my $dbh=shift;

	%cache=();
	my $sth=$dbh->prepare("SELECT fileid,nv,sha1,author,date,tags,comment,osize FROM versions;");
	$sth->execute();
	my $hh;
	while($hh=$sth->fetchrow_hashref()) {
		my @F=split(/\|/,$hh->{tags});
		for my $ctag (@F) {
			$cache{$hh->{fileid}}->{TAGS}->{$ctag}=$hh->{nv};
			$cache{$hh->{fileid}}->{NV}->{$hh->{nv}}={%$hh};
		}
	}
}

sub _empty_versions_info {
	%cache=();
}

sub _get_info_from_nv($$) {
my ($fileid,$nv)=@_;

	if(%cache) {
		my %y=($nv => $cache{$fileid}->{NV}->{$nv});
		return {%y};
	}
	return undef;
}

sub _get_nv_from_tag($$$) {
my ($dbh,$file_id,$tag)=@_;
my $h4;

	if(%cache) {
		if(exists($cache{$file_id}->{TAGS}->{$tag})) {
			return $cache{$file_id}->{TAGS}->{$tag};
		}
		return undef;
	}
	my $otag=$tag;
	$tag =~ s/\*/\%/g;
	if($tag !~ /\%/) {
		$h4=$dbh->selectall_hashref("SELECT nv,tags FROM versions WHERE fileid = '$file_id' AND (tags = '$otag' OR tags LIKE '%|$otag' OR tags LIKE '$otag|%' OR tags LIKE '%|$otag|%');","nv");
		if(defined($h4)) {
			my @C=sort(keys(%$h4));
			return $C[$#C];
		} else {
			return undef;
		}
	}

	# Ok - wild card in string, so lots more work to do...
	$h4=$dbh->selectall_hashref("SELECT nv,tags FROM versions WHERE fileid = '$file_id' ORDER BY nv;","nv");
	if(!defined($h4)) {
		return undef;
	}
	my $m=undef;
	$tag=$otag;
	$tag =~ s/\*/\.*/g;
	for my $ckey (keys %$h4) {
		if(defined($h4->{$ckey}->{tags})) {
			my @t=split(/,/,$h4->{$ckey}->{tags});
			if(grep {/^$tag$/} @t) {
				$m=$ckey;
			}
		}
	}
	return $m;
}

}

sub _get_nv_from_sha1($$$) {
my ($dbh,$file_id,$sha1)=@_;
my $h4;

	$h4=$dbh->selectall_hashref("SELECT nv,tags FROM versions WHERE fileid = '$file_id' AND sha1 = '$sha1';","nv");
	if(defined($h4)) {
		my @C=sort(keys(%$h4));
		return $C[$#C];
	} else {
		return undef;
	}
}

sub _get_nv_from_num($$$) {
my ($dbh,$file_id,$num)=@_;
my $h4;

	$h4=$dbh->selectall_hashref("SELECT nv,tags FROM versions WHERE fileid = '$file_id' AND nv = '$num';","nv");
	if(defined($h4)) {
		my @C=sort(keys(%$h4));
		return $C[$#C];
	} else {
		return undef;
	}
}

sub _get_nv_from_size($$$) {
my ($dbh,$file_id,$size)=@_;
my $h4;

	$h4=$dbh->selectall_hashref("SELECT nv,tags FROM versions WHERE fileid = '$file_id' AND osize = '$size';","nv");
	if(defined($h4)) {
		my @C=sort {$a <=> $b} (keys(%$h4));
		return $C[$#C];
	} else {
		return undef;
	}
}

# Handles %HEAD[-NN] when NN is offset or undef.
# Handles %LATEST[-NN] when NN is offset or undef.

sub _get_nv_from_head($$$) {
my ($dbh,$file_id,$offset)=@_;

	$offset=0 if !defined($offset);
	my $h4=$dbh->selectall_hashref("SELECT nv,tags FROM versions WHERE fileid = '$file_id';","nv");
	my @k=sort {$a <=> $b} (keys(%$h4));
	my $nv;
	if(@k-(1+$offset)<0) {
		$nv=$k[0];
	} else {
		$nv=$k[$#k-$offset];
	}
	return($nv);
}

sub _get_nv_from_date($$$) {
my ($dbh,$file_id,$date)=@_;
my $h4;

	if($date !~ /^(\d{8})(\-\d{6}){0,1}$/) {
		return(undef,"Date format incorrect.")
	}
	my $d2=$1;
	my $d3;
	$d3=substr($2,1) if defined($2);

	my ($year,$mon,$dom)=(substr($d2,0,4),substr($d2,4,2),substr($d2,6,2));
	$year-=1900; $mon--;
	my ($hour,$min,$sec)=(0,0,0);
	if(defined($d3)) {
		($hour,$min,$sec)=(substr($d3,0,2),substr($d3,2,2),substr($d3,4,2));
	}
	my $stime=mktime($sec,$min,$hour,$dom,$mon,$year,0,0,-1);

	$h4=$dbh->selectall_hashref("SELECT nv,tags FROM versions WHERE fileid = '$file_id' AND date >= '$stime' ORDER BY date LIMIT 1;","nv");
	if(defined($h4)) {
		my @C=sort(keys(%$h4));
		return $C[0];
	} else {
		return undef;
	}
}

#########################################################################
# Call any of the above routines as necessary to return the version	#
# information. Saves duplicating the effort in all other locations!	#
#########################################################################

sub get_nv_from_version($$$) {
my ($dbh,$file_id,$version)=@_;

	my $req_nv;
	if($version =~ /^(T|TAG):/) {
		my $t=$version;
		$t =~ s/^(T|TAG)://;
		$req_nv=_get_nv_from_tag($dbh,$file_id,$t);
		if(!defined($req_nv)) {
			return [undef,"Specified tag '$t' could not be found."];
		}
	} elsif($version =~ /^(\%H|\%HEAD|\%LATEST)/) {
		my ($j,$t);
		($j,$t)=($version =~ /^(\%H|\%HEAD|\%LATEST)-(\d+)/);
		$req_nv=_get_nv_from_head($dbh,$file_id,$t);
		if(!defined($req_nv)) {
			return [undef,"Unable to ascertain %HEAD value for '$version'."];
		}
	} elsif($version =~ /^(D|DATE):/) {
		my $e;
		my $t=$version;
		$t =~ s/^(D|DATE)://;
		($req_nv,$e)=_get_nv_from_date($dbh,$file_id,$t);
		if(defined($e)) {
			return [undef,$e];
		}
		if(!defined($req_nv)) {
			return [undef,"No versions of that date or newer could not be found."];
		}
	} elsif($version =~ /^(S|SIZE):/) {
		my $t=$version;
		$t =~ s/^(S|SIZE)://;
		$req_nv=_get_nv_from_size($dbh,$file_id,$t);
		if(!defined($req_nv)) {
			return [undef,"Specified sized file of '$version' bytes could not be found."];
		}
	} elsif($version  =~ /^[a-f0-9]{40}$/i) {
		$req_nv=_get_nv_from_sha1($dbh,$file_id,$version);
		if(!defined($req_nv)) {
			return [undef,"No versions matching SHA1 checksum of '$version' could be found."];
		}
	} elsif($version =~ /^\d+$/) {
		$req_nv=_get_nv_from_num($dbh,$file_id,$version);
		if(!defined($req_nv)) {
			return [undef,"No version number '$version' could be found."];
		}
	} else {
		return [undef,"Specified version indicator '$version' format not recognised."];
	}
	return [$req_nv,undef];
}

#########################################################################
# Usally attempting to check in a version which is the same as the head	#
# will not be allowed, though if the ALLOW_DUPS=1 then a new version	#
# will be created [usually for RCS->PV repository conversion.		#
#########################################################################

sub _insert_data_cleanup($$$) {
my ($dbh,$file_id,$nv)=@_;

	$dbh->do("DELETE FROM versions WHERE fileid = '$file_id' AND nv = '$nv';");
	$dbh->do("DELETE FROM exts WHERE fileid = '$file_id' AND nv = '$nv';");
}

sub _update_data {
my $aref=shift;
my %args=%{$aref};

	my $_nv=$args{nv};
	my $_data=$args{data};
	my $dbh=$args{dbh};
	my $file_id=$args{fileid};

	die if !defined($file_id);
	printf("DEBUG: Called _update_data [fileid=$file_id,nv=$_nv,length=%d]\n",length($_data)) if $PV3_DEBUG;
	# Grab the existing record for the rest of the fields...
	my $h = $dbh->selectrow_hashref("SELECT * FROM versions WHERE fileid = '$file_id' AND nv = '$_nv';");
	if(!defined($h->{nv})) {
		return 0;
	}
	$args{author}=_esc($h->{author});
	$args{date}=_esc($h->{date});
	$args{sha1}=_esc($h->{sha1});
	$args{tags}=_esc($h->{tags}) if !exists($args{tags});
	$args{comment}=_esc($h->{comment});

	# We have all vars, so delete the existing exts records,
	# and re-install existing record...

	$dbh->do("DELETE FROM exts WHERE fileid = '$file_id' AND nv = '$_nv';");
	my $rc=$dbh->errstr;
	if(defined($rc)) {
		return 0;
	}

	$args{nv}=$_nv;
	return _insert_data({%args});
}

sub _get_data($$$) {
my $dbh=shift;
my $file_id=shift;
my $nv=shift;

	my $h3 = $dbh->selectrow_hashref("SELECT data FROM versions WHERE fileid = '$file_id' AND nv = '$nv';");
	if(!defined($h3)) {
		printf("DEBUG: _get_data failed for: SELECT data FROM versions WHERE fileid = '$file_id' AND nv = '$nv';\n") if $PV3_DEBUG;
	
		return undef;
	}
	my $data=$h3->{data};
	# attempt to get any extensions, since the exts table exists...
	my $h4=$dbh->selectall_hashref("SELECT * FROM exts WHERE fileid = '$file_id' AND nv = '$nv';","ext");
	# exts exists, so grab out any records if necessary...
	if(! defined($h4)) {
		return \$data;
	}
	my @k=sort {$a <=> $b} (keys %$h4);
	for my $ck (@k) {
		$data.=$h4->{$ck}->{data};
	}
	printf("DEBUG: _get_data [fileid=$file_id,nv=$nv,length=%d]\n",length($data)) if $PV3_DEBUG;
	return \$data;
}

sub _insert_data {
my $aref=shift;
my %args=%{$aref};
my $res;

	my $len;
	my $dbh=$args{dbh};
	if(exists($args{len})) {
		$len=$args{len};
	} else {
		$len=length($args{data});
	}
	my $file_id=$args{fileid};
	my $name=$args{name};
	my $rc=undef;
	my $existing_nv=undef;
	my $new_nv=undef;
	$existing_nv=$args{nv} if exists($args{nv});
	$new_nv=$args{new_nv} if exists($args{new_nv});
	die "existing or new nv must be specified" if(!defined($new_nv) && !defined($existing_nv));
	if(defined($existing_nv)) {
		printf("DEBUG: Called _insert_data [existing fileid,nv=$file_id,$existing_nv,length=$len]\n") if $PV3_DEBUG;
	} else {
		printf("DEBUG: Called _insert_data [new NV fileid,length=$file_id,$len]\n") if $PV3_DEBUG;
	}
	if($len>100000) {
		# We write the first 100000 bytes into versions, but put the rest in
		# exts, in 100000 byte junks.
		my $dd=$args{data};
		my $p1=substr($args{data},0,100000);
		my $ext=1; my $offset=100000;
		if(defined($existing_nv)) {
			$res=$dbh->do("UPDATE versions SET data = '$p1' WHERE fileid = '$file_id' AND nv = '$existing_nv';");
		} else {
			my $cc=$args{comment};
			$res=$dbh->do("INSERT INTO versions (fileid,nv,author,date,sha1,tags,comment,data,osize) VALUES ('$file_id','$new_nv','$args{author}','$args{date}','$args{sha1}','$args{tags}','$cc','$p1','$len');");
		}
		$rc=$dbh->errstr;
		if(defined($rc)) {
			return 0;
		}

		#################################################################
		# If inserting and not updating, then get nv... otherwise	#
		# use the existing nv ...					#
		#################################################################

		my $nv=$existing_nv;
		$nv=$new_nv if!defined($nv);
		# Put the rest of the data in place too...
		while($offset<$len) {
			if($offset+100000>=$len) {
				$p1=substr($args{data},$offset);
				my $l=length($p1);
				$res=$dbh->do("INSERT INTO exts (fileid,nv,ext,length,data) VALUES ('$file_id','$nv','$ext','$l','$p1');");
				$rc=$dbh->errstr;
				if(defined($rc)) {
					_insert_data_cleanup($dbh,$file_id,$nv);
					return 0;
				}
			} else {
				$p1=substr($args{data},$offset,100000);
				my $l=length($p1);
				$res=$dbh->do("INSERT INTO exts (fileid,nv,ext,length,data) VALUES ('$file_id','$nv','$ext','$l','$p1');");
				$rc=$dbh->errstr;
				if(defined($rc)) {
					_insert_data_cleanup($dbh,$file_id,$nv);
					return 0;
				}
			}
			$offset+=100000;
			$ext++;
		}
	} else {
		if(defined($existing_nv)) {
			$res=$dbh->do("UPDATE versions SET data = '$args{data}' WHERE fileid = '$file_id' AND nv = '$existing_nv';");
		} else {
			my $cc=$args{comment};
			$res=$dbh->do("INSERT INTO versions (fileid,nv,author,date,sha1,tags,comment,data,osize) VALUES ('$file_id','$new_nv','$args{author}','$args{date}','$args{sha1}','$args{tags}','$cc','$args{data}','$len');");
		}
		$rc=$dbh->errstr;
		if(defined($rc)) {
			return 0;
		}
	}
	return 1;
}

sub _sha1sum($) {
my $f=shift;

	my @s=stat($f);
	return(undef) if !@s;
	my $sz=$s[7];
	my $_d;
	open(FD,$f); binmode(FD);
	my $bb=sysread(FD,$_d,$sz);
	if($bb != $sz) {
		return(undef);
	}
	close(FD);
	return sha1_hex($_d);
}

sub _add_version {
my $pvfile=shift;
my %args=@_;
my $chown_files=1;

	# Turn off chown if NO_CHOWN passed in
	if(exists($args{NO_CHOWN}) && _bool($args{NO_CHOWN})) {
		$chown_files=0;
	}

	my $add_time=time;
	if(exists($args{TIME})) {
		$add_time=$args{TIME};
	}
	my $owner=undef;
	#################################################################
	# Check the file can be written to - aborting if not.		#
	#################################################################

	if(!exists($args{DBH})) {
		if($pvfile ne "-" && ! -w $pvfile) {
			return(0,"No write access to file '$pvfile'.");
		}
	}

	my ($_author,$_date,$_sha1,$_tags,$_state,$_data,$_d,$_comment,$force,$_len);
	my $fd;

	my %notifys=();
	my $allow_dups=0;
	if(exists($args{ALLOW_DUPS})) {
		$allow_dups=$args{ALLOW_DUPS};
	}
	if(exists($args{FORCE})) {
		$force=$args{FORCE};
	} else {
		$force=1;
	}
	if(exists($args{TAGS})) {
		$_tags=$args{TAGS};
	} else {
		$_tags="";
	}

	if(exists($args{COMMENT})) {
		$_comment=$args{COMMENT}
	} else {
		$_comment="No Comment";
	}
	my @s;
	my $base_file_name;
	my $sz;

	if(!exists($args{AUTHOR})) {
		$_author=_Getpwuid($>);
	} else {
		$_author=$args{AUTHOR};
	}
	my $cuser=-1;
	my $cgroup=-1;
	if(ref($args{FILE})) {
		$base_file_name=basename($args{FILENAME});
		$_d=${$args{FILE}};
		$sz=length($_d);
	} else {
		@s=stat($args{FILE});
		$cuser=$s[4];
		$cgroup=$s[5];
		$base_file_name=basename($args{FILE});
		$sz=$s[7];
		open(FD,$args{FILE}); binmode(FD);
		sysread(FD,$_d,$sz);
		close(FD);
	}
	$_sha1=sha1_hex($_d);
	my $new_gdiff;
	my $new_xdiff;
	my $new_xdifflib;
	my $new_zlib;

	my ($dbh,$err_str);
	if(exists($args{DBH})) {
		$dbh=$args{DBH};
	} else {
		($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1});
		if(!defined($dbh)) {
			return(0,$err_str);
		} 
	}
	my ($file_id,$new_nv)=get_file_id($base_file_name,$dbh);
	if($new_nv==1) {
		# Add file id since first time we've had this file...
		my $res=$dbh->do("INSERT INTO filemaps (fileid,filename) VALUES ('$file_id','$base_file_name');");
	}
	# If the format table exists use that as the perferred format...
	# Grab out the preferred format ... though 
	my $fmt=$dbh->selectrow_hashref("SELECT * FROM format;");
	if(!defined($fmt)) {
		if(exists($args{FORMAT})) {
			$fmt=$args{FORMAT};
		} else {
			if($::PV_OS =~ /mswin/i) {
				$fmt=4; # zlib complete files...
			} elsif($::PV3_XDIFFLIB==1) {
				$fmt=2;
			} elsif($::PV3_GDIFFLIB==1) {
				$fmt=1;
			} elsif(defined($::PV3_XDIFF)) {
				$fmt=3;
			} else {
				return(0,"Unable to ascertain format to use for diffs");
			}
		}
	} else {
		$fmt=$fmt->{ty};
	}

	# fmt- 1 = gdiffdelta
	#    - 2 = xdifflib
	#    - 3 = xdiffbin
	#    - 4 = zlib

	if($fmt==1) {
		$new_gdiff=new gdiff_string($_d);
	} elsif($fmt==4) {
		$new_zlib=1;
	} elsif($fmt==2) {
		$new_xdifflib=$_d;
	} else {
		$new_xdiff=$_d;
	}

	#################################################################
	# If this version is unaltered compared to last checked in	#
	# version, no-op - unless the allow_dups is set.		#
	#################################################################

	if($new_nv!=1) {
		my $h2=$dbh->selectrow_hashref("SELECT * FROM locks WHERE fileid = '$file_id';");
		if($force<2) {
			if(!defined($h2->{who})) {
				return(0,"File '$base_file_name' is not yet checked out");
			}
			if($h2->{type} eq "L") {
				return(0,"File '$base_file_name' is locked against updates");
			}
			if($h2->{who} ne $_author) {
				if($force==0) {
					return(0,"File '$base_file_name' can not be checked in by '$_author' - it is currently checked out by '$h2->{who}'");
				} else {
					$notifys{$h2->{who}}=[] if !exists($notifys{$h2->{who}});
					push @{$notifys{$h2->{who}}},$base_file_name;
				}
			}
			if($h2->{who} ne $_author) {
				$owner=$h2->{who};
			}
		}
		$dbh->do("DELETE FROM locks WHERE fileid = '$file_id';");
		my $prev=$new_nv-1;
		$h2=$dbh->selectrow_hashref("SELECT sha1 FROM versions WHERE fileid = '$file_id' AND nv = '$prev';");
		if(defined($h2->{sha1}) && $allow_dups==0 && $h2->{sha1} eq $_sha1) {
			# If we have performed force check ins and a notify
			# callback was specified then use it now...
			if(%notifys && exists($args{NOTIFY_SUB})) {
				my $c=$args{NOTIFY_SUB};
				for my $cuser2 (keys %notifys) {
					&$c($cuser2,$notifys{$cuser2});
				}
			}
			if(!ref($args{FILE}) && $::PV_OS !~ /mswin/io && $cuser != $UID) {
				if(!rename($args{FILE},"$args{FILE}.rename.$$")) {
					chmod 0555,$args{FILE};
					return(11,$prev,$_sha1,$owner);
				}
				my ($bytes,$err)=_copyfile("$args{FILE}.rename.$$",$args{FILE});
				if(!defined($bytes)) {
					rename("$args{FILE}.rename.$$",$args{FILE});
					chmod 0555,$args{FILE};
					return(11,$prev,$_sha1,$owner);
				}
				unlink("$args{FILE}.rename.$$");
				chmod 0555,$args{FILE};
				chown($cuser,$cgroup,$args{FILE}) if $chown_files;
				return(11,$prev,$_sha1,$owner);
			}
			chmod 0555,$args{FILE};
			chown($cuser,$cgroup,$args{FILE}) if $chown_files;
			return(11,$prev,$_sha1,$owner);
		}
	}

	#################################################################
	# If this is the first version of the file then we always write	#
	# the whole contents (and always anyway for fmt==4) ...		#
	#################################################################

	my $res;
	$_len=length($_d);
	if($new_nv==1 || defined($new_zlib)) {
		$_data=encode_base64(compress($_d));
		$_date=$add_time;

		$_author=_esc($_author);
		$_date=_esc($_date);
		$_sha1=_esc($_sha1);
		$_tags=_esc($_tags);
		$_comment=_esc($_comment);
		$_data=_esc($_data);

		# Insert the data as necessary///
		$res=_insert_data( {
			dbh	=> $dbh,
			fileid	=> $file_id,
			name	=> $base_file_name,
			new_nv	=> $new_nv,
			author	=> $_author,
			date	=> $_date,
			sha1	=> $_sha1,
			tags	=> $_tags,
			comment	=> $_comment,
			data	=> $_data,
			len	=> $_len,
			});
		if($res==0) {
			if(!exists($args{DBH})) {
				$dbh->disconnect;
			}
			return(0,"Unable to insert record into file");
		}
	} else {
		#########################################################
		# Ok we need to get the current top record, so we can	#
		# generate a difference against it...			#
		#########################################################
		my $h3 = _get_data($dbh,$file_id,$new_nv-1);
		if(!defined($h3)) {
			return(0,"Unable to retrieve previous version");
		}

		if(defined($new_gdiff)) {
			my $prev_gdiff=new gdiff_string(uncompress(decode_base64($$h3)));
			my $target_gdiff=new gdiff_string;
			gdiff_delta($new_gdiff,$prev_gdiff,$target_gdiff);
			my $prev_str=$target_gdiff->stringify;
			my $_data=encode_base64(compress($_d));
			my $_data2="GDIFF:" . encode_base64(compress($prev_str));
			$_date=$add_time;
			$res=_update_data( {
				dbh	=> $dbh,
				nv	=> $new_nv-1,
				data	=> $_data2,
				fileid	=> $file_id,
				name	=> $base_file_name,
				});
			if($res==0) {
				if(!exists($args{DBH})) {
					$dbh->disconnect;
				}
				return(0,"Unable to insert record into file");
			}

			$_author=_esc($_author);
			$_date=_esc($_date);
			$_sha1=_esc($_sha1);
			$_tags=_esc($_tags);
			$_comment=_esc($_comment);
			$_data=_esc($_data);

			# Insert the data as necessary///
			$res=_insert_data( {
				dbh	=> $dbh,
				fileid	=> $file_id,
				name	=> $base_file_name,
				new_nv	=> $new_nv,
				author	=> $_author,
				date	=> $_date,
				sha1	=> $_sha1,
				tags	=> $_tags,
				comment	=> $_comment,
				data	=> $_data,
				len	=> $_len,
				});
		} elsif(defined($new_xdifflib)) {
			my $prev_xdifflib=uncompress(decode_base64($$h3));
			printf("DEBUG: prev_xdifflib length=%d\n",length($prev_xdifflib)) if $PV3_DEBUG;
			printf("DEBUG: new_xdifflib length=%d\n",length($new_xdifflib)) if $PV3_DEBUG;
			eval "use Diff::LibXDiff;";
			my $new_xdifflib = Diff::LibXDiff->bdiff($new_xdifflib,$prev_xdifflib);
			my $_data=encode_base64(compress($_d));
			my $_data2="XDIFFLIB:" . encode_base64(compress($new_xdifflib));
			$_date=$add_time;
			$res=_update_data( {
				dbh	=> $dbh,
				nv	=> $new_nv-1,
				data	=> $_data2,
				fileid	=> $file_id,
				name	=> $base_file_name,
				});
			if($res==0) {
				if(!exists($args{DBH})) {
					$dbh->disconnect;
				}
				return(0,"Unable to insert record into file");
			}

			$_author=_esc($_author);
			$_date=_esc($_date);
			$_sha1=_esc($_sha1);
			$_tags=_esc($_tags);
			$_comment=_esc($_comment);
			$_data=_esc($_data);

			# Insert the data as necessary///
			$res=_insert_data( {
				dbh	=> $dbh,
				fileid	=> $file_id,
				name	=> $base_file_name,
				new_nv	=> $new_nv,
				author	=> $_author,
				date	=> $_date,
				sha1	=> $_sha1,
				tags	=> $_tags,
				comment	=> $_comment,
				data	=> $_data,
				len	=> $_len,
				});
		} else {
			# Here we use xdiff format, s
			my $prev_xdiff=uncompress(decode_base64($h3->{data}));
			my ($fh,$fname)=tempfile();
			my ($fh2,$fname2)=tempfile();
			if(!defined($fh) || !defined($fh2)) {
				unlink($fname) if defined($fname);
				unlink($fname2) if defined($fname2);
				return(0,"Unable to generate temporary file - aborting.");
			}
			if(! print $fh $prev_xdiff) {
				close($fh);
				close($fh2);
				unlink($fname);
				unlink($fname2);
				return(0,"Unable to generate temporary file - aborting.");
			}
			close($fh);
			if(! print $fh2 $new_xdiff) {
				close($fh);
				close($fh2);
				unlink($fname);
				unlink($fname2);
				return(0,"Unable to generate temporary file - aborting.");
			}
			close($fh2);
			my $res=`$::PV3_XDIFF --bdiff $fname2 $fname 2>/dev/null`;
			my $_data=encode_base64(compress($new_xdiff)); # still needed
			my $_data2="XDIFF:" . encode_base64(compress($res));
			$_date=$add_time;
			$res=_update_data( {
				dbh	=> $dbh,
				nv	=> $new_nv-1,
				data	=> $_data2,
				fileid	=> $file_id,
				name	=> $base_file_name,
				});
			if($res==0) {
				if(!exists($args{DBH})) {
					$dbh->disconnect;
				}
				return(0,"Unable to insert record into file");
			}

			$_author=_esc($_author);
			$_date=_esc($_date);
			$_sha1=_esc($_sha1);
			$_tags=_esc($_tags);
			$_comment=_esc($_comment);
			$_data=_esc($_data);

			# Insert the data as necessary///
			$res=_insert_data( {
				dbh	=> $dbh,
				fileid	=> $file_id,
				name	=> $base_file_name,
				new_nv	=> $new_nv,
				author	=> $_author,
				date	=> $_date,
				sha1	=> $_sha1,
				tags	=> $_tags,
				comment	=> $_comment,
				data	=> $_data,
				len	=> $_len,
				});
			unlink($fname);
			unlink($fname2);
		}
	}

	if( (exists($args{CLOSEDB}) && $args{CLOSEDB}) || !exists($args{DBH})) {
		$dbh->commit;
		$dbh->disconnect;
	}
	# If we have performed force check ins and a notify
	# callback was specified then use it now...
	if(%notifys && exists($args{NOTIFY_SUB})) {
		my $c=$args{NOTIFY_SUB};
		for my $cuser2 (keys %notifys) {
			&$c($cuser2,$notifys{$cuser2});
		}
	}
	if(!ref($args{FILE}) && $::PV_OS !~ /mswin/io && $cuser != $UID) {
		if(!rename($args{FILE},"$args{FILE}.rename.$$")) {
			chmod 0555,$args{FILE};
			return(1,$new_nv,$_sha1,$owner);
		}
		my ($bytes,$err)=_copyfile("$args{FILE}.rename.$$",$args{FILE});
		if(!defined($bytes)) {
			rename("$args{FILE}.rename.$$",$args{FILE});
			chmod 0555,$args{FILE};
			return(1,$new_nv,$_sha1,$owner);
		}
		unlink("$args{FILE}.rename.$$");
		chmod 0555,$args{FILE};
		chown($cuser,$cgroup,$args{FILE}) if $chown_files;
		return(1,$new_nv,$_sha1,$owner);
	}
	chmod 0555,$args{FILE} if !ref($args{FILE});
	return(1,$new_nv,$_sha1,$owner,$file_id);
}

#########################################################################
# Return the numeric version of a file which has the specified tag.	#
# PVFILE and TAG are mandatory args					#
#########################################################################

sub get_version_from_tag {
my %args=@_;

	if(!exists($args{PVFILE})) {
		return(-1,"Missing mandatory 'PVFILE' argument");
	}
	if(!exists($args{TAG})) {
		return(-1,"Missing mandatory 'TAG' argument");
	}
	my $pvfile=$args{PVFILE}; my $tag=$args{TAG};
	if(! -e $pvfile) {
		return(-1,"File '$pvfile' does not exist.");
	}
	if(! -f $pvfile) {
		return(-1,"File '$pvfile' is not a regular file.");
	}

	my ($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1});
	if(!defined($dbh)) {
		return(-1,$err_str);
	}
	my $ar=$dbh->selectall_hashref("SELECT nv,sha1,tags FROM versions ORDER BY nv;","nv");
	for (sort(keys(%$ar))) {
		my $x=$ar->{$_}->{tags};
		my @Y=split(/\|/,$x);
		if(scalar(grep {$_ eq $tag} @Y)) {
			return $_;
		}
	}
	return 0;
}

{
my %file_name_cache=();
my %file_name_cache2=();

sub _cache_file_names($) {
my $dbh=shift;

	%file_name_cache=();
	%file_name_cache2=();
	my $sth=$dbh->prepare("SELECT * FROM filemaps");
	$sth->execute();
	my $hh;
	while($hh=$sth->fetchrow_hashref()) {
		$file_name_cache{$hh->{fileid}}=$hh->{filename};
	}
	my $sth2=$dbh->prepare("SELECT fileid, max(nv) AS maxn FROM versions GROUP BY fileid;");
	$sth2->execute();
	while($hh=$sth2->fetchrow_hashref()) {
		$file_name_cache2{$hh->{fileid}}=$hh->{maxn};
	}
}

sub _get_file_name($$) {
my ($dbh,$id)=@_;

	if(exists($file_name_cache{$id})) {
		return ($file_name_cache{$id},$file_name_cache2{$id}+1);
	}
	return (undef,undef);
}

}

# If a filename contains '*' then pattern match...

sub get_file_names($$) {
my ($base_file_name,$dbh)=@_;

	if($base_file_name !~ /\*/) {
		return [$base_file_name];
	}
	$base_file_name =~ s/\*/\%/g;
	my $h=$dbh->selectall_hashref("SELECT *  FROM filemaps WHERE filename LIKE '$base_file_name';","filename");
	return [keys %$h];
}

{
my $next_id=undef;
my $next_dbh=undef;

sub get_file_name($$) {
my ($fileid,$dbh)=@_;

	my $h=$dbh->selectrow_hashref("SELECT *  FROM filemaps WHERE fileid = '$fileid';");
	if(defined($h) && exists($h->{filename})) {
		return $h->{filename};
	}
	return undef;
}

{
my %cache=();
my %cache2=();

sub _cache_file_id_info($) {
my $dbh=shift;
my %rcache=();

	my $sth=$dbh->prepare("SELECT * FROM filemaps");
	$sth->execute();
	my $hh;
	while($hh=$sth->fetchrow_hashref()) {
		$cache{$hh->{filename}}=$hh->{fileid};
		$rcache{$hh->{fileid}}=$hh->{filename};
	}
	$sth=$dbh->prepare("SELECT fileid,max(nv) AS nv FROM versions GROUP BY fileid;");
	$sth->execute();
	while($hh=$sth->fetchrow_hashref()) {
		my $fn=$rcache{$hh->{fileid}};
		$cache2{$fn}=$hh->{nv};
	}
}

sub _empty_file_id_info {
	%cache=();
	%cache2=();
}

sub get_file_id($$;$) {
my ($base_file_name,$dbh,$no_max_nv)=@_;

	if(%cache) {
		if(exists($cache{$base_file_name})) {
			return($cache{$base_file_name},$cache2{$base_file_name}+1);
		}
	}
	my $h=$dbh->selectrow_hashref("SELECT * FROM filemaps WHERE filename = '$base_file_name';");
	if(defined($h) && exists($h->{fileid})) {
		return($h->{fileid},-1) if $no_max_nv;
		my $h2=$dbh->selectrow_hashref("select MAX(nv) AS nv FROM versions WHERE fileid = '$h->{fileid}';");
		return($h->{fileid},$h2->{nv}+1);
	}
	if(defined($next_dbh) && $dbh == $next_dbh) {
		return($next_id++,1);
	}
	$h=$dbh->selectrow_hashref("SELECT max(fileid) AS mfid  FROM filemaps;");
	$next_dbh=$dbh;
	if(!defined($h)) {
		$next_id=2;
		return (1,1);
	}
	$next_id=$h->{mfid}+1;
	return ($next_id++,1);
}

}
}

# Create a new ",pv3" file.
# Mandatory:
# FILE => Source file
# Optional
# PVFILE => Where to create the pv file [defaults to .PV3 or .pv3 sub-directory,
#	    or current directory with ,pv3 if no sub-dir exists]
# COMMENT => Opening comment
# TAGS => | separated list of tags to create file with
# FORMAT => 1,2,3,4 [gdiffdelta, xdifflib, xdiffbin, zlib]
# [NO_CHOWN] => true/false - do not perform chown if true
#
# Note NOTIFY_SUB is a subroutine that will
# get called if a force unlock of other peoples files occurs.
# Parameters called with are:
# original_locker, flist


# Returns
# (1,version,sha1) - OK
# (0,msg)   - FAILED
#
# For pv3 the repository stores multiple files and so newfile is called for
# each source file, even if the repos might exist, so we check for it and
# do not create tables, and ignore FORMAT setting if it does.

sub table_exists($$) {
my ($dbh,$table)=@_;

	my $cmd="SELECT sql FROM SQLITE_MASTER WHERE type = 'table' AND name = '$table';";
	my $h=$dbh->selectrow_hashref("$cmd");
	if(!defined($h)) {
		return 0;
	}
	return 1;
}

sub newfile {
my %args=@_;

	$PV3_DEBUG=1 if(exists($::ENV{DEBUG}) && $::ENV{DEBUG}==1);
	my $allow_existing=0;
	if(exists($args{ALLOW_EXISTING}) && $args{ALLOW_EXISTING}) {
		$allow_existing=1;
	}
	if(!exists($args{FILE})) {
		return(0,"Missing mandatory 'FILE' argument");
	}
	if(! -e $args{FILE}) {
		return(0,"File '$args{FILE}' does not exist");
	}
	if(! -f _) {
		return(0,"File '$args{FILE}' is not a regular file");
	}
	if(! -r _) {
		return(0,"File '$args{FILE}' is not readable");
	}
	if(! -w _) {
		return(0,"File '$args{FILE}' is not writeable");
	}

	# Define what we want to call the file
	my $pvfile;
	my ($dbh,$err_str);
	if(exists($args{DBH})) {
		$dbh=$args{DBH};
	} else {
		if(exists($args{PVFILE})) {
			$pvfile=$args{PVFILE};
		} else {
			if(-d ".PV3") {
				$pvfile=".PV3/.pv3";
			} elsif(-d ".pv3") {
				$pvfile=".pv3/.pv3";
			} elsif(-d "PV3") {
				$pvfile="PV3/.pv3";
			} else {
				$pvfile=".pv3";
			}
		}
		($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1, AutoCommit => 0, force_open => 1});
		if(!defined($dbh)) {
			return(0,$err_str);
		}
		$args{DBH}=$dbh;
	}
	chmod 0664,$pvfile;
	return _add_version($pvfile,%args);
}

sub dump_database {
my %args=@_;
my $pvfile=undef;
my @C=();

	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	if(! -e $pvfile) {
		return [undef,"Unable to find suitable PV3 file."];
	}

	my ($original_dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1,AutoCommit => 0});
	if(!defined($original_dbh)) {
		return [undef,$err_str];
	}

	push @C,"CREATE TABLE versions(fileid INTEGER,nv INTEGER,author VARCHAR(10),date INTEGER,sha1 CHAR(40),tags VARCHAR(100),comment VARCHAR(50),data BLOB,osize INTEGER);";

	push @C,"CREATE TABLE filemaps (fileid INTEGER PRIMARY KEY, filename CHAR(255));";
	push @C,"CREATE INDEX filemaps_i ON filemaps (filename);";
	push @C,"CREATE TABLE locks (fileid INTEGER PRIMARY KEY,nv INTEGER,sha1 CHAR(40),type CHAR(1),who VARCHAR(10),date INTEGER);";
	push @C,"CREATE TABLE exts (fileid INTEGER,nv INTEGER,ext INTEGER,length INTEGER,data BLOB);";
	push @C,"CREATE TABLE format (version INTEGER,ty INTEGER);";

	my $h5=$original_dbh->selectall_hashref("SELECT * FROM filemaps;","fileid");
	for my $ckey (sort {$a <=> $b} (keys %$h5)) {
		push @C,"INSERT INTO filemaps (fileid,filename) VALUES ('$ckey','$h5->{$ckey}->{filename}');";
	}
	$h5=$original_dbh->selectall_hashref("SELECT * FROM versions;","fileid");
	for my $ckey (sort {$a <=> $b} (keys %$h5)) {
		push @C,"INSERT INTO versions (fileid,nv,author,date,sha1,tags,comment,data,osize) VALUES ('$ckey','$h5->{$ckey}->{nv}','$h5->{$ckey}->{author}','$h5->{$ckey}->{date}','$h5->{$ckey}->{sha1}','$h5->{$ckey}->{tags}','$h5->{$ckey}->{comment}','$h5->{$ckey}->{data}','$h5->{$ckey}->{osize}');";
	}
	$h5=$original_dbh->selectall_hashref("SELECT * FROM locks;","fileid");
	for my $ckey (sort {$a <=> $b} (keys %$h5)) {
		push @C,"INSERT INTO locks (fileid,nv,sha1,type,who,date) VALUES ('$ckey','$h5->{$ckey}->{nv}','$h5->{$ckey}->{sha1}','$h5->{$ckey}->{type}','$h5->{$ckey}->{who}','$h5->{$ckey}->{date}');";
	}
	$h5=$original_dbh->selectall_arrayref("SELECT * FROM exts;",{ Slice => {} });
	for my $cref (@$h5) {
		push @C,"INSERT INTO exts (fileid,nv,ext,length,data) VALUES ('$cref->{fileid}','$cref->{nv}','$cref->{ext}','$cref->{length}','$cref->{data}');";
	}
	$h5=$original_dbh->selectall_arrayref("SELECT * FROM format;",{ Slice => {} });
	for my $cref (@$h5) {
		push @C,"INSERT INTO format (version,ty) VALUES ('$cref->{version}','$cref->{ty}');";
	}
	$original_dbh->disconnect();
	return [\@C,undef];
}

# Create a new ",pv" file.
# Mandatory:
# FILE => Source file
# Optional
# PVFILE => Where to create the pv file [defaults to PV sub-directory,
#	    or current directory if no PV sub-dir.]
# COMMENT => Opening comment
# TAGS => | separated list of tags to create file with
#
# Note NOTIFY_SUB is a subroutine that will
# get called if a force unlock of other peoples files occurs.
# Parameters called with are:
# original_locker, flist


# Returns
# (1,version,sha1) - OK
# (0,msg)   - FAILED

sub addversion {
	return newfile(@_,"ALLOW_EXISTING",1);
}

# Extract a specified file and drop a copy of it into the current directory.

# FILE => filename to extract [must be read-only if it exists]
# PVFILE => Where the pv exists [optional]
# CHECKOUT => indicates the file should be locked for editing [co state]
# LOCK => indicates the file should be locked for no update [lock state]
# VERSION => numeric or sha1 [specified version to extract, otherwise does latest]
# DB => Existing DB connection [do not open/close]
# FORCE => Allow the overwrite of code that is not recognised..
# MEMCOPY => If present and 1 returns a memory copy referenc rather than
#            writing the file to disk. 
# IGNORE_MISSING -> If the specified file is not under code control at
#                   present then return (1,0,"",filename,[])
# IGNORE_VERSION_ERRORS -> Ignore missing versions and do not give errors.
# SOURCE_OWNER_GROUP -> [user,group[ - id's to set user and group (optional)
# INDIR - extract the files into this directory not current directory (optional)
# [NO_CHOWN] => true/false - do not perform chown if true
#
# Will error if any row has a status of locked / co
# Returns (0,errmsg) or (1,nv,sha1,filename,[memcopy],tags) if checked out
# 

#
# Only the most recent version is a full copy, otherwise we need to apply
# changes from the most recent back to the version required using the necessayr
# algorithm. We check if the string starts with either GFIFF:,XDIFF: or XDIFFLIB:
# and default to GDIFF: if not present. 
#
# This allows the algorithm to change even in the same file...
#
# FILE or FILEID can be a single file, or a reference to an array of files
# VERSION is optional and defaults to latest checked in...

sub get {
my %args=@_;
my $co=0;
my $lock=0;
my $db;
my $memcopy=0;
my $ignore_version_errors=0;
my $ignore_missing=0;
my $indir=undef;
my $source_owner=undef;
my $source_group=undef;
my $chown_files=1;
my $perm_checks=1;

	# Turn off chown if NO_CHOWN passed in
	if(exists($args{NO_CHOWN}) && _bool($args{NO_CHOWN})) {
		$chown_files=0;
	}
	# Turn off permissinos checks if NO_PERM_CHECKS passed in
	if(exists($args{NO_PERM_CHECKS}) && _bool($args{NO_PERM_CHECKS})) {
		$perm_checks=0;
	}

	if(defined($args{SOURCE_OWNER_GROUP})) {
		$source_owner=$args{SOURCE_OWNER_GROUP}->[0];
		$source_group=$args{SOURCE_OWNER_GROUP}->[1];
	}
	$indir=$args{INDIR} if(exists($args{INDIR}));
	$ignore_missing=$args{IGNORE_MISSING} if(exists($args{IGNORE_MISSING}));
	$ignore_version_errors=$args{IGNORE_VERSION_ERRORS} if(exists($args{IGNORE_VERSION_ERRORS}));
	$PV3_DEBUG=1 if(exists($::ENV{DEBUG}) && $::ENV{DEBUG}==1);
	$db=$args{DB} if exists($args{DB});
	if(! exists($args{FILE}) && !(exists($args{FILEID}) && exists($args{VAR}))) {
		return [[0,"Missing mandatory 'FILE' or 'FILEID' argument.",""]];
	}
	$co=1 if exists($args{CHECKOUT}) && $args{CHECKOUT};
	$lock=1 if exists($args{LOCK}) && $args{LOCK};
	$memcopy=1 if (exists($args{MEMCOPY}) && $args{MEMCOPY});

	my $pvfile;
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	if($pvfile ne "-" && ! -e $pvfile) {
		return [[0,",pv file not found!",""]];
	}

	#################################################################
	# Check the file can be written to - aborting if not.		#
	#################################################################

	if($pvfile ne "-" && ! -r $pvfile) {
		return [[0,"No read access to file '$pvfile'.",""]];
	}

	#################################################################
	# Open pv file and look for a locked / co version.	Only	#
	# get the file is not locked/checked out.			#
	#################################################################

	my $dbh; my $err_str;
	if(defined($db)) {
		$dbh=$db;
	} else {
		($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1, AutoCommit => 0});
		if(!defined($dbh)) {
			return [[0,$err_str,""]];
		}
	}
	my @files=();
	my @file_ids=();
	my ($base_file_name,$file_id,$new_nv,$ftype);
	# If FILE list exists, but is empty then we populate 
	my %tag_hash=();
	my %sha_hash=();
	if(exists($args{FILE}) && ref($args{FILE}) && (
		length(@{$args{FILE}})==0 || !defined($args{FILE}->[0]))) {
		my $h3=$dbh->selectall_hashref("SELECT * FROM filemaps;","fileid");
		@file_ids=keys(%$h3);
		# If dealing with more than 100 files + VERSION specified and is a tag, load in 
		# tag mapping all in one go to save time...
		my $t1=time;
		if(@file_ids>100 && exists($args{VERSION}) && $args{VERSION} =~ /^(T|TAG):(.*)/) {
			my $ctag=$2;
			# my $h2=$dbh->selectall_hashref("SELECT fileid,nv,author,date,sha1,tags,comment,osize FROM versions;","fileid");
			my $sth=$dbh->prepare("SELECT fileid,nv,author,date,sha1,tags,comment,osize FROM versions;");
			$sth->execute();
			my $hh;
			while($hh=$sth->fetchrow_hashref()) {
				my ($cid,$nv,$ctags,$s)=($hh->{fileid},$hh->{nv},$hh->{tags},$hh->{sha1});
				$sha_hash{"$cid.$nv"}=$s;
				my @Z=split(/\|/,$ctags);
				if(grep {$ctag eq $_} @Z) {
					$tag_hash{$cid}=$nv;
				}
			}
		}
		my $t2=time;
		if($t2-$t1>10) {
			print "Warning: get directory cache took a long time: ",$t2-$t1," seconds.\n";
		}
		$ftype=2;
	} else {
		if(exists($args{FILE})) {
			$ftype=1;
			if(ref($args{FILE})) {
				@files=(@{$args{FILE}});
			} else {
				@files=($args{FILE});
			}
			# We check for '*' in names and if found use 'like' to 
			# pattern match those files in repository

			my @files2=();
			for my $cfile (@files) {
				my $base_file_name=basename($cfile);
				my $filenames=get_file_names($base_file_name,$dbh);
				push @files2,$_ foreach(@$filenames);
			}
			@files=@files2;
			my $_t2=time;
		} else {
			$ftype=2;
			if(ref($args{FILEID})) {
				@file_ids=(@{$args{FILEID}});
			} else {
				@file_ids=($args{FILEID});
			}
		}
	}
	my @res=();
	my $h5=$dbh->selectall_hashref("SELECT * FROM format;","version");
	my @K=keys(%$h5); 
	my $_format=$h5->{$K[0]}->{ty};
	_cache_file_id_info($dbh);
	_cache_file_names($dbh);
	for my $cfile (@files,@file_ids) {
		next if !defined($cfile);

		if($ftype==1) {
			$base_file_name=basename($cfile);
			($file_id,$new_nv)=get_file_id($base_file_name,$dbh);
		} else {
			$file_id=$cfile;
			($cfile,$new_nv)=_get_file_name($dbh,$file_id);
			if($cfile) {
				$base_file_name=$cfile;
			} else {
				if($ignore_missing) {
					push @res,[1,0,"",$args{FILE},[]];
				} else {
					push @res,[0,"File mapping for id '$file_id' failed!",""];
				}
				next;
			}
		}
		if($new_nv==1) {
			if($ignore_missing) {
				push @res,[1,0,"",$args{FILE},[]];
			} else {
				push @res,[0,"File not under code control.",$base_file_name];
			}
			next;
		}
		if(defined($args{CHECKOUT}) && $args{CHECKOUT} ||
			defined($args{LOCK}) && $args{LOCK} ||
			defined($args{CHECKLOCK}) && $args{CHECKLOCK}) {
			my $h = $dbh->selectrow_hashref("SELECT * FROM locks WHERE fileid = '$file_id';");
			if(defined($h->{type})) {
				my $s="Locked" if $h->{type} eq "L";
				$s="Checked out" if $h->{type} eq "C";
				push @res,[0,"Version $h->{sha1},$h->{nv} is in state '$s'.",$base_file_name];
				next;
			}
		}

		my $req_nv=undef;
		my $dest_file=$base_file_name;
		if(defined($indir)) {
			$dest_file=File::Spec->join($indir,$base_file_name);
		}
		my $df_exists=0;
		if($memcopy==0 && $ftype==1 && -e $dest_file) {
			if(! -f _) {
				push @res,[0,"File is not a regular file.",$dest_file];
				next;
			}
			$df_exists=1;
			if($::PV_OS !~ /mswin/io) {
				my $mode=(stat(_))[2] & 0222;
				if( $perm_checks && (!exists($args{FORCE}) || !$args{FORCE}) && $mode) {
					push @res,[0,"File is writable.",$dest_file];
					next;
				}
			}
		}

		#################################################################
		# If a version is not specified, then get the top one...	#
		# and record highest since that determines the change to apply	#
		# to get hold of the version in question.			#
		#################################################################

		my $sha1_nv=undef;
		my $max_nv=$new_nv-1;
		my $cversion;
		if(!exists($args{VERSION}) || !defined($args{VERSION})) {
			$req_nv=$max_nv;
		} else {
			if(%tag_hash) {
				next if !exists($tag_hash{$file_id});
				$max_nv=$tag_hash{$file_id};
			}
			if(!defined($req_nv)) {
				my $ar=get_nv_from_version($dbh,$file_id,$args{VERSION});
				if(!defined($ar->[0])) {
					if($ignore_version_errors==0) {
						push @res,[0,$ar->[1],$base_file_name];
					}
					next;
				} else {
					$req_nv=$ar->[0];
				}
			}
		}

		#################################################################
		# If FORCE not set or 0, then need to check to see if the	#
		# file exists, and if so only continue if contents are known.	#
		#################################################################
		my $nv_version_of_file=undef;
		my $_sha1;
		my $_keep_data;
		my $_keep_user;
		my $_keep_perms;
		my $_tags;
		if($memcopy==0 && ($df_exists && (!exists($args{FORCE}) || $args{FORCE}==0))) {
			my @sb=stat(_);
			my $sz=$sb[7];
			my $fd;
			my $_d;
			if(!open($fd,$dest_file)) {
				push @res,[-1,"Unable to read file - ignoring retrieval.",$base_file_name];
				next;
			}
			binmode($fd);
			sysread($fd,$_keep_data,$sz);
			close($fd);
			$_sha1=sha1_hex($_keep_data);
			my $h = $dbh->selectrow_hashref("SELECT nv,tags FROM versions WHERE fileid = '$file_id' AND sha1 = '$_sha1';");
			if(!defined($h) || !defined($h->{nv})) {
				push @res,[-1,"Unknown contents of file - not retrieved.",$base_file_name];
				next;
			}
			$nv_version_of_file=$h->{nv};
			$_tags=$h->{tags};
			$_keep_user=$sb[4];
			$_keep_perms=$sb[2];
		}
		my ($working_gdiff,$output_gdiff,$todo_gdiff);
		my ($working_string,$output_string,$todo_string);
		my $cur_nv=$max_nv;
		my $errored=0;
		my $h;
		my $keep_file=0;
		while(1) {
			if(defined($nv_version_of_file) &&
				$nv_version_of_file==$req_nv) {
				$keep_file=1;
				$h={sha1=>$_sha1,nv=>$req_nv,data=>undef};
				last;
			}
			my $h22=_get_data($dbh,$file_id,$cur_nv);
			if(!defined($h22)) {
				push @res,[-1,"Failed to get version '$cur_nv'.",$base_file_name];
				$errored=1; last;
			}

			if(!exists($sha_hash{"$file_id.$cur_nv"})) {
				$h=$dbh->selectrow_hashref("SELECT nv,sha1,tags FROM versions WHERE fileid = '$file_id' AND nv = '$cur_nv';");
				if(!defined($h->{nv})) {
					push @res,[0,"Failed to get version '$cur_nv'.",$base_file_name];
					$errored=1; last;
				}
				$h->{data}=$$h22;
			} else {
				$sha1_nv=$sha_hash{"$file_id.$cur_nv"};
				$h={sha1=>$sha1_nv,nv=>$cur_nv,data=>$$h22};
			}
			if($PV3_DEBUG) {
				print "DEBUG: Extracting version $cur_nv.\n";
			}
			if($cur_nv == $max_nv || $_format==4) {
				$working_string=uncompress(decode_base64($h->{data}));
				if($PV3_DEBUG) {
					print "DEBUG: Top Version size: ",length($working_string),"\n";
				}
				if($cur_nv == $req_nv) {
					last;
				}
			} else {
				my $type=1; # default to gdiff
				$todo_string=$h->{data};
				if($todo_string =~ /^GDIFF:/) {
					$type=1;
					$todo_string=~ s/^GDIFF://;
				} elsif($todo_string =~ /^XDIFF:/) {
					$type=3;
					$todo_string=~ s/^XDIFF://;
				} elsif($todo_string =~ /^XDIFFLIB:/) {
					$type=2;
					$todo_string=~ s/^XDIFFLIB://;
				}
				# Decode the string to process now the header 
				# has been removed.	
				$todo_string=uncompress(decode_base64($todo_string));

				if($PV3_DEBUG) {
					print "DEBUG: Delta Version type: $type\n";
					print "DEBUG: Delta Version size: ",length($todo_string),"\n";
				}
				if(defined($working_string)) {
					if($type==3) {
						my ($fh,$fname1)=tempfile("xdiff_1_XXXXXX");
						if(!defined($fh)) {
							push @res,[0,"Unable to generate temporary file - aborting.",$base_file_name];
							$errored=1; last;
						}
						close($fh);
						my ($fh2,$fname2)=tempfile("xdiff_2_XXXXXX");
						if(!defined($fh2)) {
							push @res,[0,"Unable to generate temporary file - aborting.",$base_file_name];
							$errored=1; last;
						}
						close($fh2);
						if($PV3_DEBUG) {
							printf("DEBUG: Working size: %d, todo size: %d\n",length($working_string),length($todo_string));
						}
						open($fh,">$fname1");
						if(!defined($fh)) {
							push @res,[0,"Failed to write to temporary file ['$fname1'] for xdiff.",$base_file_name];
							$errored=1; last;
						}
						binmode($fh);
						if(! print $fh $todo_string) {
							close($fh); unlink($fname1);
							push @res,[0,"Failed to write to temporary file ['$fname1'] for xdiff.",$base_file_name];
							$errored=1; last;
						}
						if(! close($fh)) {
							unlink($fname1);
							push @res,[0,"Failed to write to temporary file ['$fname1'] for xdiff.",$base_file_name];
							$errored=1; last;
						}
						open($fh,">$fname2");
						if(!defined($fh)) {
							push @res,[0,"Failed to write to temporary file for xdiff."];
							$errored=1; last;
						}
						binmode($fh);
						if(! print $fh $working_string) {
							close($fh); unlink($fname2);
							push @res,[0,"Failed to write to temporary file for xdiff.",$base_file_name];
							$errored=1; last;
						}
						if(! close($fh)) {
							unlink($fname2);
							push @res,[0,"Failed to write to temporary file for xdiff.",$base_file_name];
							$errored=1; last;
						}
						if($PV3_DEBUG) {
							print "DEBUG: $::PV3_XDIFF --bpatch $fname2 $fname1 2>/dev/null\n";
						}
						$working_string=`$::PV3_XDIFF --bpatch $fname2 $fname1 2>/dev/null`;
						if($?<<8) {
							unlink($fname1,$fname2);
							push @res,[0,"xdiff --bpatch $fname2 $fname1 failed.",$base_file_name];
							$errored=1; last;
						}
						unlink($fname1,$fname2);
					} elsif($type==2) {
						# This is an explicit XDIFFLIB: entry
						my $patched = Diff::LibXDiff->bpatch($working_string,$todo_string);
						$working_string=$patched;
					} else {
						# This is the default or an explicit GDIFF: entry
						my $working_gdiff=new gdiff_string($working_string);
						my $todo_gdiff=new gdiff_string($todo_string);
						my $output_gdiff=new gdiff_string;
						gdiff_apply($working_gdiff,$todo_gdiff, $output_gdiff);
						undef $working_gdiff;
						my $ws=new gdiff_string($output_gdiff->stringify);
						$working_string=$ws->stringify()
					}
				} else {
					$working_string=$todo_string;
				}
				last if $cur_nv == $req_nv;
			}
			$cur_nv--;
		}
		#################################################################
		# If we failed during a file build move on to the next one.	#
		#################################################################
		if($errored) {
			next;
		}
		if($keep_file) {
			if(exists($args{VAR})) {
				${$args{VAR}}=$_keep_data;
			}
			if(!$co && !$lock) {
				push @res,[1,$req_nv,$_sha1,$base_file_name,undef,$_tags];
				next;
			}
			if($UID!=$_keep_user) {
				my ($a,$b)=_copyfile($dest_file,"$dest_file.${$}_rename");
				if(!defined($a)) {
					push @res,[0,"Cannot create copy of file.",$base_file_name];
					next;
				}
				rename("$dest_file.${$}_rename",$dest_file);
			}
			chmod $_keep_perms|0200,$dest_file;
			push @res,[1,$req_nv,$_sha1,$base_file_name,undef,$_tags];
			my $s;
			my $s2=_Getpwuid($>);
			my $s3=time;
			$s="L" if $lock;
			$s="C" if $co;
			$dbh->do("INSERT INTO locks (fileid,nv,sha1,type,who,date) VALUES ('$file_id','$req_nv','$_sha1','$s','$s2',$s3);");
			if($::PV_OS !~ /mswin/i && defined($source_owner)) {
				chmod 0555,$dest_file;
				chown($source_owner,$source_group,$dest_file) if $chown_files;
			}
			next;
		}

		my $do_rename=0;
		if($memcopy) {
			push @res,[1,$req_nv,$h->{sha1},$base_file_name,\$working_string,$h->{tags}];
		} elsif(exists($args{VAR})) {
			${$args{VAR}}=$working_string;
		} else {
			if(-f $dest_file) {
				if(! rename($dest_file,"$dest_file.${$}_rename")) {
					push @res,[0,"Unable to rename file to temporary name - $!",$base_file_name];
					next;
				}
			}
			$do_rename=1;
		}

		if(! $memcopy && !exists($args{VAR})) {
			if($base_file_name ne "-" && -f $dest_file) {
				if(!unlink($dest_file)) {
					rename("$dest_file.${$}_rename",$dest_file) if $do_rename;
					push @res,[0,"Can not make file writable.",$base_file_name];
					next;
				}
			}
			my $fd;
			if(!open($fd,">$dest_file")) {
				rename("$dest_file.${$}_rename",$dest_file) if $do_rename;
				push @res,[0,"Unable to open file for writing.",$base_file_name];
				next;
			}
			binmode($fd);
			if(! print $fd $working_string) {
				close($fd);
				unlink($dest_file);
				rename("$dest_file.${$}_rename",$dest_file) if $do_rename;
				push @res,[0,"Unable to write file to disk: $!",$base_file_name];
				next;
				
			}
			if($base_file_name ne "-") {
				if($co) {
					chmod 0755,$dest_file;
				} else {
					chmod 0555,$dest_file;
				}
			}
			unlink("$dest_file.${$}_rename") if $do_rename;
		}
		#################################################################
		# If locking it add the lock/checkout reference now.		#
		#################################################################

		my $nv=$h->{nv};
		if($co || $lock) {
			my $s;
			my $s2=_Getpwuid($>);
			my $s3=time;
			$s="L" if $lock;
			$s="C" if $co;
			$dbh->do("INSERT INTO locks (fileid,nv,sha1,type,who,date) VALUES ('$file_id','$nv','$h->{sha1}','$s','$s2',$s3);");
		} else {
			if($::PV_OS !~ /mswin/i && defined($source_owner)) {
				chmod 0555,$dest_file;
				chown($source_owner,$source_group,$dest_file) if $chown_files;
			}
		}
		push @res,[1,$nv,$h->{sha1},$base_file_name,undef,$h->{tags}] if !$memcopy;
	}
	_empty_file_id_info();
	if(!defined($db)) {
		$dbh->commit;
		$dbh->disconnect;
	}
	return([@res]);
}

sub pvexists {
my %args=@_;

	if(!exists($args{FILE}) || !defined($args{FILE})) {
		return(-1,"Missing mandatory argument");
	}
	my $pvfile;
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	if(! -e $pvfile) {
		return(0,undef);
	}
	my ($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1});
	if(!defined($dbh)) {
		return(-1,$err_str);
	}
	my $base_file_name=basename($args{FILE});
	my ($file_id,$new_nv)=get_file_id($base_file_name,$dbh);
	if($new_nv==1) {
		return(0,undef);
	}
	return(1,$new_nv-1);
}

sub pvexists_multiple {
my %args=@_;

	my @errs=();
	my @ok=();
	my @unlock=();
	if(!exists($args{FILES}) || !defined($args{FILES})) {
		return(-1,["Missing mandatory argument"],[@ok]);
	}
	my $pvfile;
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	my ($dbh,$err_str);
	my $need_new=0;
	($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1,AutoCommit => 0});
	if(!defined($dbh)) {
		return(-1,[$err_str],[]);
	}
	# Now attempt to check in all files, recording errors and version
	# information for reporting back...

	for my $cfile (@{$args{FILES}}) {
		my $base_file_name=basename($cfile);
		my ($r1,$r2,$r3,$owner)=pv3::addversion(FILE => $base_file_name,DBH=>$dbh,%args);
		if($r1==0) {
			push @errs,$r2;
		} elsif($r1==11) {
			push @unlock,[$cfile,$owner];
		} else {
			push @ok,[$cfile,$r2,$r3,$owner];
		}
	}
	if(defined($dbh)) {
		$dbh->commit;
		$dbh->disconnect;
	}
	return(1,[@errs],[@ok],[@unlock]);
}

# Lock the specified file if it is locked. Will only unlock if
# user = user of FORCE =1.
# Args: FILE,[PVFILE,FORCE],[NOTIFY_SUB]
# FILE can be an individual file or a REFERENCE
# Returns array of:
# [-1,error,file]	- file error
# [-2,msg,file]		- file not locked
# [0,nv,sha1,who,date,file] - unlocked file;
#
# Note NOTIFY_SUB is a subroutine that will
# get called if a force unlock of other peoples files occurs.
# Parameters called with are:
# original_locker, flist

sub unlock {
my %args=@_;
my $force=0;

	if(!exists($args{FILE}) || !defined($args{FILE})) {
		return [[-1,"Missing mandatory argument.",""]];
	}
	if(exists($args{FORCE}) && $args{FORCE}) {
		$force=1;
	}
	my $pvfile;
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	if(! -e $pvfile) {
		my $cc=basename($pvfile);
		return [[-1,"No $cc file [not under code control].",""]];
	}
	#################################################################
	# Check the file can be written to - aborting if not.		#
	#################################################################

	if($pvfile ne "-" && ! -w $pvfile) {
		return [[-1,"No write access to file '$pvfile'.",""]];
	}

	my @files;
	if(ref($args{FILE})) {
		@files=@{$args{FILE}};
	} else {
		@files=($args{FILE});
	}

	#################################################################
	# Open the database and remove lock if necessary.		#
	#################################################################

	my %notifys=();
	my $_author=_Getpwuid($>);
	my ($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1,AutoCommit => 0});
	if(!defined($dbh)) {
		return [[-1,$err_str,""]];
	}
	if(!defined($dbh)) {
		my $cc=basename($pvfile);
		return [[-1,"Unable to open $cc file - bad format?",""]];
	}
	my @res=();
	for my $cfile (@files) {
		my $base_file_name=basename($cfile);
		my ($file_id,$new_nv)=get_file_id($base_file_name,$dbh);
		if($new_nv==1) {
			push @res,[-2,"File is not under code control.",$base_file_name];
			next;
		}
		my $h2=$dbh->selectrow_hashref("SELECT * FROM locks WHERE fileid = '$file_id';");
		if(!defined($h2->{who})) {
			push @res,[-2,"File is not yet checked out.",$base_file_name];
			next;
		}
		if($h2->{type} eq "L") {
			push @res,[-1,"File is locked against updates.",$base_file_name];
			next;
		}
		if($h2->{who} ne $_author) {
			if(! $force) {
				push @res,[-1,"File is currently checked out by '$h2->{who}'.",$base_file_name];
				next;
			} else {
				$notifys{$h2->{who}}=[] if !exists($notifys{$h2->{who}});
				push @{$notifys{$h2->{who}}},$base_file_name;
			}
		}
		my $r=$dbh->do("DELETE FROM locks WHERE fileid = '$file_id';");
		if(!$r) {
			return [-1,"Unable to delete lock on file.",$base_file_name];
			next;
		}
		my @SB=stat($base_file_name); 
		my $mode=$SB[2]&07555;
		chmod $mode,$base_file_name;
		push @res,[0,$h2->{nv},$h2->{sha1},$h2->{who},$h2->{date},$base_file_name];
	}
	$dbh->commit;
	$dbh->disconnect;
	# If we have force-unlock files owned by other people then
	# we call the NOTIFY_SUB if defined...
	if(%notifys && exists($args{NOTIFY_SUB})) {
		my $c=$args{NOTIFY_SUB};
		for my $cuser (keys %notifys) {
			&$c($cuser,$notifys{$cuser});
		}
	}
	return [@res];
}

# Return the status of the specified file, args are:
# FILE
# SANITY - if present sanity checking will be performed....
# PVFILE [optional]
#
# Returns [-1,msg[,file]]		- file does not exist, or not under code control#
#         [0,file]			- file checked in and sane
#	  [1,nv,sha1,user,date,file] 	- checked out [details specified]
#	  [2,file]			- check in but local contents unrecognised.
#         [3,nv,sha1,file]		- not checked out, but 'non-current' version locally
#
# The returned results are a reference to an array. The FILE can be a filename,
# or a reference to a list of filenames.

# If the FILE is an empty list then return details of checked out files...
 
sub status {
my %args=@_;
my @res=();

	my @files=();
	if(!exists($args{FILE}) || !defined($args{FILE})) {
		return [[-1,"Missing mandatory argument"]];
	}
	my $pvfile;
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	if(! -e $pvfile) {
		my $cc=basename($pvfile);
		return [[-1,"No $cc file [not under code control]"]];
	}

	if(ref($args{FILE})) {
		@files=(@{$args{FILE}});
	} else {
		@files=($args{FILE});
	}
	#################################################################
	# Now get details of any locks					#
	#################################################################

	my ($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1, AutoCommit => 0});
	if(!defined($dbh)) {
		return [[-1,$err_str]];
	}
	return [[-1,"Unable to open PV file"]] if !defined($dbh);
	my $sanity=0;
	if(exists($args{SANITY})) {
		$sanity=1;
	}
	if(! @files) {
		my $h2=$dbh->selectall_hashref("SELECT fileid,nv,author,date,sha1,tags,comment,osize FROM versions;","fileid");
		my $h3=$dbh->selectall_hashref("SELECT * FROM filemaps;","fileid");
		for my $cid (keys %$h2) {
			if(exists($h3->{$cid})) {
				push @files,$h3->{$cid}->{filename};
			}
		}
	}

	# Read in all locks information - easy to look for
	my %lock_hash=();
	my $sth=$dbh->prepare("SELECT * FROM locks;");
	$sth->execute();
	my $hh;
	while($hh=$sth->fetchrow_hashref()) {
		my ($cid,$cnv,$csha1,$ctype,$cwho,$cdate)=($hh->{fileid},$hh->{nv},$hh->{sha1},$hh->{type},$hh->{who},$hh->{date});
		$lock_hash{$cid}=[$cnv,$csha1,$ctype,$cwho,$cdate];
	}

	# hash info ... read only utility
	# _hash_file_info($dbh);
	my $ckey;
	while($ckey=each(%lock_hash)) {
		my $fn=get_file_name($ckey,$dbh);
		if(grep {$fn eq $_} @files) {
			my $l=$lock_hash{$ckey};
			if($l->[2] eq  "C") {
				push @res,[1,$l->[0],$l->[1],$l->[3],$l->[4],$fn,$l->[2]];
				next;
			}
		}
	}

	if(!$sanity) { 
		$dbh->disconnect();
		return [@res];
	}

	for my $cfile (@files) {
		my $base_file_name=basename($cfile);
		my ($file_id,$new_nv)=get_file_id($base_file_name,$dbh);
		if($new_nv==1) {
			push @res,[-1,"File not under code control.",$cfile];
			next;
		}
		#################################################################
		# Not checked out, so see if contents are valid.		#
		# Firstly get SHA1 of file...					#
		#################################################################

		my $s=Digest::SHA1->new;
		my @sb=stat($cfile);
		if(! @sb && exists($lock_hash{$file_id})) {
			push @res,[4,$cfile]; # check out, but deleted locally.
		}
		next if ! -e _;
		if(-w _ && !exists($lock_hash{$file_id})) {
			push @res,[5,$cfile]; # writable, not checked out.
		}
		my $fd;
		if(!open($fd,$cfile)) {
			push @res,[-1,"Can not open file for reading.",$cfile];
			next;
		}
		binmode($fd);
		$s->addfile($fd); close($fd);
		my $od=$s->hexdigest;

		my $xxx=$new_nv-1;
		my $h2=$dbh->selectrow_hashref("SELECT * FROM versions WHERE fileid = '$file_id' AND nv = '$xxx';");
		if($h2->{sha1} eq $od) {
			push @res,[0,$cfile];
			next;
		}

		#################################################################
		# Now compare od against all sha1 versions to see if 		#
		# non-current or unrecognised content.				#
		#################################################################

		if(! exists($lock_hash{$file_id})) {
			my $h = $dbh->selectrow_hashref("SELECT nv FROM versions WHERE fileid = '$file_id' AND sha1 = '$od' ORDER BY nv;");
			if(!defined($h->{nv})) {
				push @res,[3,$h->{nv},$od,$cfile];
				next;
			}
		}
		push @res,[2,$cfile];
	}
	$dbh->disconnect();
	return [@res];
}

sub locked_count {
my %args=@_;
my $get_flist=0;

	my $pvfile;
	if(exists($args{FLIST}) && $args{FLIST}) {
		$get_flist=1;
	}
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	if(! -e $pvfile) {
		my $cc=basename($pvfile);
		my $dd=basename($pvfile);
		return (-1,"No $cc file [directory '$dd' not under code control?]");
	}
	my ($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1});
	if(!defined($dbh)) {
		return (-1,$err_str);
	}
	my $h2=$dbh->selectrow_hashref("SELECT COUNT(*) AS c FROM locks;");
	if(!defined($h2->{c})) {
		return (-1,"Unable to get lock count.");
	}
	my $h3=$dbh->selectrow_hashref("SELECT COUNT(*) AS c FROM filemaps;");
	if(!defined($h3->{c})) {
		return (-1,"Unable to get file count.");
	}
	if($get_flist) {
		my @L=();
		my $h4=$dbh->selectall_hashref("SELECT * FROM locks;","fileid");
		for my $ckey (keys %$h4) {
			my $fn=get_file_name($ckey,$dbh);
			push @L,$fn;
		}
		return ($h2->{c},$h3->{c},[@L]);
	} else {
		return ($h2->{c},$h3->{c});
	}
}

# This routine will return the details for a specific release,
# or all releases that are under code control for a specified file.
# Args FILE,[PVFILE],[VERSION]
# IGNORE_MISSING_PV      -> If set then if the pvfile is missing simply
#                           return an empty list rather than an error.
# IGNORE_MISSING_VERSION -> If a version has been specified and a file
#                           does not include that version simply omit it
#                           from the list rather than giving errors.
#
# Returns (-1,msg) - failed
#         (0,ref,locks) - reference to hash,array ref;
#			version -> {}->nv,sha1,author,date,tags,comment
#			locks   [nv,sha1,type,who,date]
#
# FILE can be reference to list rather than just a single file.

sub info {
my %args=@_;
my $ignore_missing_version=0;
my $ignore_missing_pv=0;

	my ($dbh,$err_str);
	if(!exists($args{FILE}) || !defined($args{FILE})) {
		return [[-1,"Missing mandatory argument"]];
	}
	if(exists($args{IGNORE_MISSING_VERSION}) && $args{IGNORE_MISSING_VERSION}) {
		$ignore_missing_version=1;
	}
	if(exists($args{IGNORE_MISSING_PV}) && $args{IGNORE_MISSING_PV}) {
		$ignore_missing_pv=1;
	}
	my $pvfile;
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	if(! -e $pvfile) {
		if($ignore_missing_pv) {
			return [];
		}
		my $cc=basename($pvfile);
		return [[-1,"No $cc file [not under code control]"]];
	}

	($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1});
	if(!defined($dbh)) {
		return [[-1,$err_str]];
	}

	my @files=();
	if(ref($args{FILE})) {
		@files=@{$args{FILE}};
	} else {
		@files=($args{FILE});
	}
	# If no files have been given, default to all files...
	if(! @files) {
		my $h2=$dbh->selectall_hashref("SELECT * FROM versions;","fileid");
		my $h3=$dbh->selectall_hashref("SELECT * FROM filemaps;","fileid");
		for my $cid (keys %$h2) {
			if(exists($h3->{$cid})) {
				push @files,$h3->{$cid}->{filename};
			}
		}
	}

	my @res=();
	_cache_file_id_info($dbh);
	my $set_version=0;
	_empty_versions_info();
	if(@files>100 && exists($args{VERSION}) && defined($args{VERSION})) {
		_cache_versions_info($dbh);
		$set_version=1;
	}
	for my $cfile (@files) {
		my $e;
		my $base_file_name=basename($cfile);
		# my $t1=time;
		my ($file_id,$new_nv)=get_file_id($base_file_name,$dbh,$set_version);
		# my $t2=time;
		# printf("get_file_id=%.5f\n",$t2-$t1);
		if($new_nv==1) {
			push @res,[-1,"File $base_file_name is not under code control.",$base_file_name];
			next;
		}
		my $req_nv;
		if(exists($args{VERSION}) && defined($args{VERSION})) {
			# $t1=time;
			my $ar=get_nv_from_version($dbh,$file_id,$args{VERSION});
			if(!defined($ar->[0])) {
				if($ignore_missing_version==0) {
					push @res,[-1,$ar->[1],$base_file_name];
				}
				next;
			} else {
				$req_nv=$ar->[0];
			}
			# $t2=time;
			# printf("get_nv_from_version=%.5f\n",$t2-$t1);
		}

		# $t1=time;
		my $ar=undef;
		if($set_version) {
			$ar=_get_info_from_nv($file_id,$req_nv);
		} else {
			local $SIG{__WARN__}=sub { ; };
			if(defined($req_nv)) {
				$ar=$dbh->selectall_hashref("SELECT fileid,nv,sha1,author,date,tags,comment,osize FROM versions WHERE fileid = '$file_id' AND nv = '$req_nv';","nv");
			} else {
				$ar=$dbh->selectall_hashref("SELECT fileid,nv,sha1,author,date,tags,comment,osize FROM versions WHERE fileid = '$file_id';","nv");
			}
		}
		if(!defined($ar)) {
			push @res,[-1,"Unable to query 'versions' table for file $args{FILE} [$req_nv]."];
			next;
		}
		$ar->{name}=$base_file_name;
		# $t2=time;
		# printf("q#1=%.5f\n",$t2-$t1);
		# When also get details of any locks held and return them.

		# $t1=time;
		my @L=();
		my $locks=$dbh->prepare("SELECT * FROM locks WHERE fileid = '$file_id';");
		my $slocks=-1;
		eval '$slocks=$locks->execute;';
		if(!defined($slocks)) {
			print "Missing 'locks' table for $base_file_name?\n";
			push @res,[-1,"Missing 'locks' table for file $base_file_name."];
			next;
		}
		my $arr;
		while($arr=$locks->fetchrow_hashref) {
			my $r=[$arr->{nv},$arr->{sha1},$arr->{type},$arr->{who},$arr->{date}];
			push @L,$r;
		}
		push @res,[0,$ar,[@L]];
		# $t2=time;
		# printf("q#2=%.5f\n",$t2-$t1);
	}
	_empty_versions_info($dbh);
	_empty_file_id_info($dbh);
	return [@res];
}

# This returns more supplementary information - the type and
# size of each version defined ...
# returns (-1,errmsg) or (-2,warnmsg) or (0,arr_ref)
#
# Warnings are generated when SANITY=>1 is specified.
#
# Works with a ref to an array too...
sub info2 {
my %args=@_;
my $sanity_check=0;

	if(!exists($args{FILE}) || !defined($args{FILE})) {
		return [[-1,"Missing mandatory argument"]];
	}
	if(exists($args{SANITY}) && defined($args{SANITY})) {
		$sanity_check=$args{SANITY};
	}
	my $pvfile;
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	my @res=();
	if(! -e $pvfile) {
		my $cc=basename($pvfile);
		push @res,[-1,"No $cc file [not under code control]"];
		return [@res];
	}

	my ($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1});
	if(!defined($dbh)) {
		push @res,[-1,$err_str];
		return [@res];
	}

	my $h5=$dbh->selectall_hashref("SELECT * FROM format;","version");
	my @K=keys(%$h5); 
	my $_format=$h5->{$K[0]}->{ty};
	my @files=();
	if(ref($args{FILE})) {
		@files=@{$args{FILE}};
	} else {
		@files=($args{FILE});
	}

	# If no files have been given, default to all files...
	if(! @files) {
		my $h2=$dbh->selectall_hashref("SELECT * FROM versions;","fileid");
		my $h3=$dbh->selectall_hashref("SELECT * FROM filemaps;","fileid");
		for my $cid (keys %$h2) {
			if(exists($h3->{$cid})) {
				push @files,$h3->{$cid}->{filename};
			}
		}
	}
	if($sanity_check) {
		my @A=();
		my @W=();
		my ($dfd,$cf);
		if(!opendir($dfd,".")) {
			push @res,[-1,"Unable to open current directory: $!",""];
			return [@res];
		}
		while($cf=readdir($dfd)) {
			next if -d $cf;
			next if $cf eq $pvfile;
			push @A,$cf;
			my @S=stat($cf);
			my $m=$S[2] & 07777;
			$m&=00222;
			if($m>0) {
				push @W,$cf;
			}
		}
		closedir($dfd);
		#########################################################
		# Check if all writable files are checked out...	#
		#########################################################
		for my $cw (@W) {
			my ($file_id,$new_nv)=get_file_id($cw,$dbh);
			if($new_nv>1) {
				my $h2=$dbh->selectrow_hashref("SELECT * FROM locks WHERE fileid = '$file_id';");
				if(!defined($h2->{who})) {
					push @res,[-2,"File is writable, but not checked out.",$cw];
				}
			}
		}
		#########################################################
		# Check each file in the directory, looking for:	#
		# [1] Files not under code control.			#
		# [2] Not checked out, but unrecognised content.	#
		# [3] Non-current (but known) content.			#
		#########################################################
		for my $cf (@A) {
			my ($file_id,$new_nv)=get_file_id($cf,$dbh);
			if($new_nv==1) {
				push @res,[-2,"File not under code control.",$cf];
				next;
			}
			# Get SHA1 of file...
			my $sha1=_sha1sum($cf);
			if(!defined($sha1)) {
				push @res,[-2,"Unable to open file to validate content.",$cf];
				next;
			}
			my $h4=$dbh->selectall_hashref("SELECT * FROM versions WHERE fileid = '$file_id' AND sha1 = '$sha1';","nv");
			if(!defined($h4) || scalar(keys(%$h4))==0) {
				push @res,[-2,"Unrecognised file content - and not checked out.",$cf];
				next;
			}
			my @K=keys(%$h4);
			if($K[0] < $new_nv-1) {
				push @res,[-2,"Valid content, but not latest version.",$cf];
			}
		}
	}
	for my $cfile (@files) {
		my $base_file_name=basename($cfile);
		my ($file_id,$new_nv)=get_file_id($base_file_name,$dbh);
		if($new_nv==1) {
			push @res,[-1,"File $base_file_name is not under code control.",$base_file_name];
			next;
		}
		my $max_nv=$new_nv-1;
		my $req_nv;
		my $versions;

		if(exists($args{VERSION}) && defined($args{VERSION})) {
			my $ar=get_nv_from_version($dbh,$file_id,$args{VERSION});
			if(!defined($ar->[0])) {
				push @res,[-1,$ar->[1],$base_file_name];
				next;
			} else {
				$req_nv=$ar->[0];
			}
		}
		if(defined($req_nv)) {
			$versions=$dbh->prepare("SELECT * FROM versions WHERE fileid = '$file_id' AND nv = '$req_nv';");
		} else {
			$versions=$dbh->prepare("SELECT * FROM versions WHERE fileid = '$file_id';");
		}
		my $sversions;
		eval '$sversions=$versions->execute;';
		if(!defined($sversions)) {
			push @res,[-1,"Missing 'versions' table for file $args{FILE}."];
			next;
		}
		my $arr;
		my $vinfo={};
		while($arr=$versions->fetchrow_hashref) {
			my $sz=length($arr->{data});
			my $type="Gdiff";
			if($max_nv eq $arr->{nv} || $_format==4) {
				$type="Full-copy";
			} else {
				if(substr($arr->{data},0,6) eq "GDIFF:") { $type="Gdiff"; }
				if(substr($arr->{data},0,6) eq "XDIFF:") { $type="Xdiff-bin"; }
				if(substr($arr->{data},0,9) eq "XDIFFLIB:") { $type="Xdiff-lib"; }
			}
			my $h4=$dbh->selectall_hashref("SELECT ext,length FROM exts WHERE fileid = '$file_id' AND nv = '$arr->{nv}';","ext");
			$sz+=$h4->{$_}->{length} foreach(keys %$h4);
			$vinfo->{$arr->{nv}}={type=>$type,size=>$sz};
			$vinfo->{name}=$cfile;
		}
		push @res,[0,$vinfo];
	}
	return [@res];
}

#########################################################################
# This is a routine to return information in a similar format to the	#
# parse_rlogs function used in previous CM2 repository formats.		#
#########################################################################

sub parse_rlogs {
my %args=@_;
my $sanity_check=0;

	if(!exists($args{FILE})) {
		$args{FILE}=[];
	}
	my $pvfile;
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	my @res=();
	if(! -e $pvfile) {
		my $cc=basename($pvfile);
		push @res,[-1,"No $cc file [not under code control]"];
		return [@res];
	}

	my ($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1});
	if(!defined($dbh)) {
		push @res,[-1,$err_str];
		return [@res];
	}

	my $h5=$dbh->selectall_hashref("SELECT * FROM format;","version");
	my @K=keys(%$h5); 
	my $_format=$h5->{$K[0]}->{ty};
	my @files=();
	if(ref($args{FILE})) {
		@files=@{$args{FILE}};
	} else {
		@files=($args{FILE});
	}

	# If no files have been given, default to all files...
	if(! @files) {
		my $h2=$dbh->selectall_hashref("SELECT * FROM versions;","fileid");
		my $h3=$dbh->selectall_hashref("SELECT * FROM filemaps;","fileid");
		for my $cid (keys %$h2) {
			if(exists($h3->{$cid})) {
				push @files,$h3->{$cid}->{filename};
			}
		}
	}

	my $all_data={};
	# generate RCS info
	for my $cfile (@files) {
		my $cdata={};
		$cdata->{revisions}={};

		my $base_file_name=basename($cfile);
		my ($file_id,$new_nv)=get_file_id($base_file_name,$dbh);
		if($new_nv==1) {
			push @res,[-1,"File $base_file_name is not under code control.",$base_file_name];
			next;
		}
		my $max_nv=$new_nv-1;
		my $req_nv;
		my $version_info;
		$cdata->{lhead}=$max_nv;


		$version_info=$dbh->selectall_hashref("SELECT * FROM versions WHERE fileid = '$file_id';","nv");

		for my $cnv (keys %$version_info) {
			if($cnv == $max_nv) {
				$cdata->{head}=$version_info->{$cnv}->{sha1};
				$cdata->{size}=$version_info->{$cnv}->{osize};
			}
			my @tt=localtime($version_info->{$cnv}->{date});
			my $ds=sprintf("%04d/%02d/%02d %02d:%02d:%02d",
				$tt[5]+1900,$tt[4]+1,$tt[3],$tt[2],$tt[1],$tt[0]);
			$cdata->{revisions}->{$cnv}={
				text => $version_info->{$cnv}->{comment},
				sha1 => $version_info->{$cnv}->{sha1},
				author => $version_info->{$cnv}->{author},
				date => $ds};
		}
		$cdata->{revlist}=[sort {$b <=> $a} keys(%$version_info)];
		my $h=$dbh->selectrow_hashref("SELECT * FROM locks WHERE fileid = '$file_id';");
		if(defined($h) && exists($h->{nv})) {
			$cdata->{locks}=[{
				nv => $h->{nv},
				version => $h->{sha1},
				cotime => $h->{date},
				user => $h->{who}}];
		} else {
			$cdata->{locks}=[];
		}
		$all_data->{$base_file_name}={%$cdata};
	}
	return $all_data;
}

# This will takes a series of files (or all files if none are specified)
# and will return the differences between the two versions specified...
# Arguments are:
# FILE (name or reference to array of names) - empty array = all files
# PVFILE (the PV versioning information)
# VERSION1 - the old version
# VERSION2 - the name version
# STYLE -> old,context,unified - the name version
#
# VERSION1/VERSION2 can be NN,SHA1 or S:, D:, %HEAD[-nn] or T: configurations...
# or _CURRENT_ for the current contents of the file!

sub diff {
my %args=@_;
my $style=undef;

	my ($dbh,$err_str);
	if(!exists($args{FILE}) || !defined($args{FILE})) {
		return [[-1,"Missing mandatory FILE argument."]];
	}
	if(exists($args{STYLE}) && defined($args{STYLE})) {
		my $s=lc($args{STYLE});
		$style="Unified" if $s eq "unified";
		$style="Context" if $s eq "context";
		$style="OldStyle" if $s eq "oldstyle";
	}
	if(!exists($args{VERSION1}) || !defined($args{VERSION1})) {
		return [[-1,"Missing mandatory VERSION1 argument"]];
	}
	if(!exists($args{VERSION2}) || !defined($args{VERSION2})) {
		return [[-1,"Missing mandatory VERSION2 argument"]];
	}
	my $pvfile;
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	if(! -e $pvfile) {
		my $cc=basename($pvfile);
		return [[-1,"No $cc file [not under code control]"]];
	}

	($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1});
	if(!defined($dbh)) {
		return [[-1,$err_str]];
	}

	my @files=();
	if(ref($args{FILE})) {
		@files=@{$args{FILE}};
	} else {
		@files=($args{FILE});
	}
	# If no files have been given, default to all files...
	if(! @files) {
		my $h2=$dbh->selectall_hashref("SELECT * FROM versions;","fileid");
		my $h3=$dbh->selectall_hashref("SELECT * FROM filemaps;","fileid");
		for my $cid (keys %$h2) {
			if(exists($h3->{$cid})) {
				push @files,$h3->{$cid}->{filename};
			}
		}
	}

	my @res=();
	for my $cfile (@files) {
		my $base_file_name=basename($cfile);
		my ($file_id,$new_nv)=get_file_id($base_file_name,$dbh);
		if($new_nv==1) {
			push @res,[-1,"File $base_file_name is not under code control.",$base_file_name];
			next;
		}

		my $V1=$args{VERSION1}; 
		if($V1 ne "_CURRENT_") {
			my $ar=get_nv_from_version($dbh,$file_id,$args{VERSION1});
			if(!defined($ar->[0])) {
				push @res,[-1,$ar->[1],$base_file_name];
				next;
			} else {
				$V1=$ar->[0];
			}
		}
		my $V2=$args{VERSION2}; 
		if($V2 ne "_CURRENT_") {
			my $ar=get_nv_from_version($dbh,$file_id,$args{VERSION2});
			if(!defined($ar->[0])) {
				push @res,[-1,$ar->[1],$base_file_name];
				next;
			} else {
				$V2=$ar->[0];
			}
		}

		my ($tref,$err)=_getdiff($dbh,$file_id,$V1,$V2,$base_file_name,$style);
		if(!defined($tref)) {
			push @res,[-1,$err,$base_file_name];
		} else {
			push @res,[1,$tref,$base_file_name];
		}
	}
	return [@res];
}

# FILE, TAG, [PVFILE], [VERSION], [ALLOWOPEN], [IGNORE]
# return (-1,error), (-2,warning) or (0,undef) - ok
# 
# If FILE is a reference to an array then an array
# of results is returned, rather than a actual list...
# Allowopen will tag the latest checked in version if the content
# of a file is not recognised.
# The IGNORE flag simply silently ignores files that are not under code control...
# TAGDB is a db which is used to record detailed per-file tag info
# TAGDIR is relative directory for recording info
# UNTAG_OTHERS - if true then it will remvoe the specified tag from
#                all other entries in the code control directory.


sub addtag {
my %args=@_;
my $untag_others=0;

	my $t1=time;
	if(!exists($args{FILE})) {
		return [[-1,"Missing mandatory 'FILE' argument.",""]];
	}
	if(!exists($args{TAG})) {
		return [[-1,"Missing mandatory 'TAG' argument.",""]];
	}
	if(exists($args{UNTAG_OTHERS}) && $args{UNTAG_OTHERS}) {
		$untag_others=1;
	}
	my $tag=$args{TAG};
	my @files;
	my @other_files=();
	if(ref($args{FILE})) {
		@files=@{$args{FILE}};
	} else {
		@files=($args{FILE});
	}
	my $pvfile;
	my $force=0;
	my $allowopen=0;
	if(exists($args{ALLOWOPEN})) {
		$allowopen=$args{ALLOWOPEN};
	}
	if(exists($args{FORCE})) {
		$force=$args{FORCE};
	}
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	if(! -e $pvfile) {
		return [[-1,",pv file for '$args{FILE}' not found.",""]];
	}

	#################################################################
	# Check the file can be written to - aborting if not.		#
	#################################################################

	if($pvfile ne "-" && ! -w $pvfile) {
		return [[-1,"No write access to file '$pvfile'.",""]];
	}

	#################################################################
	# Can not add new tags if locked or checked out, unless the	#
	# force option is used...					#
	#################################################################

	my ($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1,AutoCommit => 0});
	if(!defined($dbh)) {
		return [[-1,$err_str,""]];
	}
	my %lock_hash=();
	my $sth=$dbh->prepare("SELECT * FROM locks;");
	$sth->execute();
	my $hh;
	while($hh=$sth->fetchrow_hashref()) {
		my ($cid,$cnv,$csha1,$ctype,$cwho,$cdate)=($hh->{fileid},$hh->{nv},$hh->{sha1},$hh->{type},$hh->{who},$hh->{date});
		$lock_hash{$cid}=[$cnv,$csha1,$ctype,$cwho,$cdate];
	}

	if($untag_others) {
		my $h2=$dbh->selectall_hashref("SELECT * FROM versions;","fileid");
		my $h3=$dbh->selectall_hashref("SELECT * FROM filemaps;","fileid");
		for my $cid (keys %$h2) {
			if(exists($h3->{$cid})) {
				my $x=$h3->{$cid}->{filename};
				if(! grep {$_ eq $x} @files) {
					push @other_files,$x;
				}
			}
		}
	}

	my @res=();
	my @rows=();

	my %tag_hash=();
	my %fileid_info_hash=();
	my %sha1_files=();
	my @files2=();
	for my $cfile (@files) {
		my $fd;
		my $_d="";
		next if ! -f $cfile;
		my @d=stat(_);
		if(!open($fd,$cfile)) {
			push @res,[-1,"Unable to read file - ignoring from tagging.",basename($cfile)];
			next;
		}
		binmode($fd);
		sysread($fd,$_d,$d[7]);
		close($fd);
		$sha1_files{$cfile}=sha1_hex($_d);
		push @files2,$cfile;
	}
	@files=@files2;
	$sth=$dbh->prepare("SELECT tags,nv,sha1,fileid,osize FROM versions;");
	$sth->execute();
	while($hh=$sth->fetchrow_hashref()) {
		my ($cid,$cnv,$csha1,$ctags)=($hh->{fileid},$hh->{nv},$hh->{sha1},$hh->{tags});
		if(!exists($fileid_info_hash{$cid}->{$csha1})) {
			$fileid_info_hash{$cid}->{$csha1}=[$cnv,$ctags];
		} else {
			# Update with info if nv is newer...
			my $o_cnv=$fileid_info_hash{$cid}->{$csha1}->[0];
			if($o_cnv<$cnv) {
				$fileid_info_hash{$cid}->{$csha1}=[$cnv,$ctags];
			}
		}
		next if !defined($hh->{tags});
		my @T=split(/\|/,$hh->{tags});
		next if(!@T || !defined($T[0]));
		for my $ct (@T) {
			$tag_hash{$cid}->{$ct}=$cnv;
		}
	}
	_cache_file_id_info($dbh);
	my $t2=time;
	# print "Time to cache file info is: ",$t2-$t1," seconds.\n";
	if($t2-$t1 > 20) {
		print "Warning: Time to cache file info is large: ",$t2-$t1," seconds.\n";
	}

	$t1=time;
	for my $cfile (@files) {
		my $base_file_name=basename($cfile);
		my ($file_id,$new_nv)=get_file_id($base_file_name,$dbh,1);  # hashed version
		if($new_nv==1) {
			push @res,[-2,"File not under code control.",$base_file_name];
			next;
		}
		my $h;
		if(%lock_hash) {
			if($allowopen==0 && $force==0) {
				if(exists($lock_hash{$file_id})) {
					my $s="?";
					$s="Locked" if $lock_hash{$file_id}->[2] eq "L";
					$s="Checked out" if $lock_hash{$file_id}->[2] eq "C";
					push @res,[-1,"Version $lock_hash{$file_id}->[0],$lock_hash{$file_id}->[1] is in state '$s'.",$base_file_name];
					next;
				}
			}
		}

		#################################################################
		# If a version is not specified, then get the file checksum and	#
		# use that to determine the version...				#
		#################################################################

		my $realver;
		my $realsha1;
		my $existing_tags;
		my $ccc="";
		if(!exists($args{VERSION})) {
			$realver=undef;
			$realsha1=$sha1_files{$cfile};
			if(!exists($fileid_info_hash{$file_id})) {
				push @res,[-1,"Contents of '$base_file_name' not recognised - not tagged.",$base_file_name];
				next;
			}
			$realver=$fileid_info_hash{$file_id}->{$realsha1}->[0];
			$existing_tags=$fileid_info_hash{$file_id}->{$realsha1}->[1];
		} else {
			#################################################################
			# Version has been specified, so use it to find realver...	#
			#################################################################
			my $ar=get_nv_from_version($dbh,$file_id,$args{VERSION});
			if(!defined($ar->[0])) {
				push @res,[-1,$ar->[1],$base_file_name];
				next;
			} else {
				$realver=$ar->[0];
				my $h = $dbh->selectrow_hashref("SELECT nv,tags,sha1 FROM versions WHERE fileid = '$file_id' AND nv = '$realver';");
				$realsha1=$h->{sha1};
				$existing_tags=$h->{tags};
			}
			if(!defined($realver)) {
				push @res,[-1,"Unable to find version '$args{VERSION}'.",$base_file_name];
				next;
			}
		}

		#################################################################
		# realver contains the version to change and realsha1 		#
		# contents the sha1 version, and existing_tags any tags...	#
		#################################################################

		#################################################################
		# If the same tag exists elsewhere it must be removed from 	#
		# those records... However there some optimisations that can 	#
		# be done...							#
		# [1] If nv of existing tag == realver, then no change!		#
		# [2] 
		#################################################################

		if(exists($tag_hash{$file_id}->{$tag})) {
			my $cvert=$tag_hash{$file_id}->{$tag};
			if($cvert eq $realver) {
				push @rows,{existing=>1};
				next; # No change - optimisation one!
			}
			$h = $dbh->selectrow_hashref("SELECT tags,nv,sha1 FROM versions WHERE fileid = '$file_id' AND nv = '$cvert';");
			my @T=split(/\|/,$h->{tags});
			my @NT=();
			for (@T) {
				push @NT,$_ if $_ ne $tag;
			}
			my $tt=join("|",@NT);
			$dbh->do("UPDATE versions SET tags = '$tt' WHERE fileid = '$file_id' AND nv = '$h->{nv}';");
		}
		if(!defined($existing_tags) || $existing_tags eq "") {
			$ccc=$tag;
		} else {
			$ccc="$tag|$existing_tags";
		}
		push @rows,{
			existing => 0,
			tags => $ccc,
			file_id => $file_id,
			realver => $realver,
			base_file_name => $base_file_name,
			realsha1 =>$realsha1,
		};
	}
	$t2=time;
	# print "Time to gather tagging requirements is: ",$t2-$t1," seconds.\n";
	if($t2-$t1 > 20) {
		print "Warning: Time to gather tagging requirements is large: ",$t2-$t1," seconds.\n";
	}
	$t1=time;
	$sth = $dbh->prepare("UPDATE versions SET tags = ? WHERE fileid = ? AND nv = ?;");
	if(!defined($sth)) {
		push @res,[-1,"Unable to prepare UPDATE statement!"];
		$dbh->rollback;
		$dbh->disconnect;
		return([@res]);
	}
	for my $cres (@rows) {
		if($cres->{existing}==0) {
			my $re=$sth->execute($cres->{tags},$cres->{file_id},$cres->{realver});
			if(!$re) {
				push @res,[-1,"Failed to update record.",$cres->{base_file_name}];
				next;
			}
		}
		push @res,[0,$cres->{realsha1},$cres->{realver},$cres->{base_file_name}];
	}
	$t2=time;
	# print "Time to update versions table is: ",$t2-$t1," seconds.\n";
	if($t2-$t1 > 20) {
		print "Warning: Time to update versions table is large: ",$t2-$t1," seconds.\n";
	}
	
	_empty_file_id_info();
	$dbh->commit;
	$dbh->disconnect;
	if(@other_files) {
		removetag(FILE => [@other_files],PVFILE=>$pvfile,TAG=>$args{TAG});
	}
	return([@res]);
}

# FILE, TAG, [PVFILE]
# return array reference of results like:
#  [-1,error,file] - error
#  [-2,msg,file] - no tag in file
#  [0,sh1,nv,file] - ok
#
# FILE can be a file or a refernce to a list of files...
# If FILE is an empty list than all files in the repository
# will have the tag removed.

sub removetag {
my %args=@_;

	if(!exists($args{FILE})) {
		return [[-1,"Missing mandatory 'FILE' argument.",""]];
	}
	if(!exists($args{TAG})) {
		return [[-1,"Missing mandatory 'TAG' argument.",""]];
	}
	my @files;
	if(ref($args{FILE})) {
		@files=@{$args{FILE}};
	} else {
		@files=($args{FILE});
	}

	my $allowopen=0;
	if(exists($args{ALLOWOPEN})) {
		$allowopen=$args{ALLOWOPEN};
	}
	my $tag=$args{TAG};
	my $pvfile;
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	if(! -e $pvfile) {
		return [[-1,",pv file for '$args{FILE}' not found.",""]];
	}

	#################################################################
	# Check the file can be written to - aborting if not.		#
	#################################################################

	if($pvfile ne "-" && ! -w $pvfile) {
		return [[-1,"No write access to file '$pvfile'.",""]];
	}

	#################################################################
	# Connect to the pv file in question, and remove any		#
	# reference to the tag.						#
	#################################################################

	my ($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1,AutoCommit => 0});
	if(!defined($dbh)) {
		return [[-1,$err_str,""]];
	}

	# If no files are given remove the tag from all files...

	if(! @files) {
		my $h2=$dbh->selectall_hashref("SELECT * FROM versions;","fileid");
		my $h3=$dbh->selectall_hashref("SELECT * FROM filemaps;","fileid");
		for my $cid (keys %$h2) {
			if(exists($h3->{$cid})) {
				push @files,$h3->{$cid}->{filename};
			}
		}
	}

	my @res=();
	for my $cfile (@files) {
		my $base_file_name=basename($cfile);
		my ($file_id,$new_nv)=get_file_id($base_file_name,$dbh);
		if($new_nv==1) {
			push @res,[-1,"File is not under code control.",$base_file_name];
			next;
		}
		if($allowopen==0) {
			my $h = $dbh->selectrow_hashref("SELECT * FROM locks WHERE fileid = '$file_id';");
			if(defined($h->{type})) {
				my $s="Locked" if $h->{type} eq "L";
				$s="Checked out" if $h->{type} eq "C";
				push @res,[-1,"Version $h->{sha1},$h->{nv} is in state '$s'.",$base_file_name];
				next;
			}
		}

		my $realver;
		my $ccc="";
		my $h = $dbh->selectrow_hashref("SELECT * FROM versions WHERE fileid = '$file_id' AND (tags = '$tag' OR tags LIKE '$tag|%' OR tags LIKE '%|$tag' OR tags LIKE '%|$tag|%');");
		if(!defined($h) || !defined($h->{tags})) {
			push @res,[-2,"Tag specified not in use.",$base_file_name];
			next;
		}

		#################################################################
		# Found the record so remove the tag in question and rewrite	#
		#################################################################

		my @T=grep { $_ ne $tag } (split(/\|/,$h->{tags}));
		my $t=join("|",@T);
	
		$dbh->do("UPDATE versions SET tags = '$t' WHERE fileid = '$file_id' AND nv = '$h->{nv}';");
		push @res,[0,$h->{sha1},$h->{nv},$base_file_name];
	}
	$dbh->commit;
	$dbh->disconnect;
	return [@res];
}

#########################################################################
# The below routine is responsible for removing a file from the PV3	#
# file. It does not perform any checks. Removing code is not 		#
# recommended of course!						#
#########################################################################

sub rmfile {
my %args=@_;

	my ($dbh,$err_str);
	if(!exists($args{FILE}) || !defined($args{FILE})) {
		return [[-1,"Missing mandatory argument"]];
	}
	my $pvfile;
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	if(! -e $pvfile) {
		my $cc=basename($pvfile);
		return [[-1,"No $cc file [no code control?]"]];
	}
	($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1,AutoCommit => 0});
	if(!defined($dbh)) {
		return(0,$err_str);
	}

	my @files=();
	if(ref($args{FILE})) {
		@files=@{$args{FILE}};
	} else {
		@files=($args{FILE});
	}
	my @res=();
	for my $cfile (@files) {
		my $e;
		my $base_file_name=basename($cfile);
		my ($file_id,$new_nv)=get_file_id($base_file_name,$dbh,0);
		if($new_nv==1) {
			push @res,[-1,"File $base_file_name is not under code control.",$base_file_name];
			next;
		}
		# File definitely under code control, so now remove it!!
		$dbh->do("delete from versions where fileid = '$file_id';");
		$dbh->do("delete from locks where fileid = '$file_id';");
		$dbh->do("delete from exts where fileid = '$file_id';");
		$dbh->do("delete from filemaps where fileid = '$file_id';");
		push @res,[1,$cfile,$file_id];
	}
	$dbh->commit();
	$dbh->disconnect();
	return [@res];
}

#########################################################################
# The following routine will perform a vacuum on the file in question	#
# in an attempt to reduce the space the DB occupies.			#
# Argument is just PVFILE - though it will work against against		#
# any SQLite data file.							#
# Result is (1,undef) = ok  or (0,err) if error				#
#########################################################################

sub compact {
my %args=@_;

	if(!exists($args{PVFILE})) {
		return(0,"Missing mandatory 'PVFILE' argument");
	}
	my $pvfile=$args{PVFILE};
	return (0,"Specified file does not exist.") if ! -e $pvfile;
	return (0,"Specified file is not a file!") if ! -f $pvfile;

	#################################################################
	# Check the file can be written to - aborting if not.		#
	#################################################################

	if($pvfile ne "-" && ! -w $pvfile) {
		return(0,"No write access to file '$pvfile'.");
	}

	my ($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1});
	if(!defined($dbh)) {
		return(0,$err_str);
	}

	my $res=$dbh->do("VACUUM;");
	return(1,undef);
}

#########################################################################
# Copies a file in the PV3 file. Will remove the tags from the new copy.#
# Args are [PVFILE],[PVFILE2],FILE,NEWFILE				#
# Returns (1,undef) = OK or (0,err) = ERROR				#
# If the PVFILE2 is specified then the file will be copied from one	#
# PVFILE to another.							#
#########################################################################

sub copy {
my %args=@_;

	my $rc;
	my $pvfile;
	my $pvfile2;
	if(exists($args{PVFILE2})) {
		$pvfile2=$args{PVFILE2};
	}
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	if(!exists($args{FILE})) {
		return(0,"Missing mandatory 'FILE' argument");
	}
	if(!exists($args{NEWFILE})) {
		return(0,"Missing mandatory 'NEWFILE' argument");
	}
	#################################################################
	# This doesn't actually need the file in the filesystem,	#
	# it just uses whaever is in the pv3 file.			#
	#################################################################

	my $dbh2;
	my ($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1});
	if(!defined($dbh)) {
		return(0,"Unable to open version control file.\n$err_str");
	}
	if(defined($pvfile2)) {
		($dbh2,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile2","","",{ sqlite_handle_binary_nulls => 1});
		if(!defined($dbh2)) {
			return(0,"Unable to open destinanation version control file.\n$err_str");
		}
	}
	my $obase_file_name=basename($args{FILE});
	my $nbase_file_name=basename($args{NEWFILE});
	my ($ofile_id,$onew_nv)=get_file_id($obase_file_name,$dbh);
	my ($nfile_id,$nnew_nv);
	if(!defined($pvfile2)) {
		($nfile_id,$nnew_nv)=get_file_id($nbase_file_name,$dbh);
	} else {
		($nfile_id,$nnew_nv)=get_file_id($nbase_file_name,$dbh2);
	}
	if($nnew_nv>1) {
		if(defined($pvfile2)) {
			return(0,"File $nbase_file_name already under code control in destination directory.");
		} else {
			return(0,"File $nbase_file_name already under code control.");
		}
	}
	if($onew_nv==1) {
		return(0,"File $obase_file_name is not under version control.");
	}
	# Read rows, one at time and then write them...
	my $cid=1;
	my $dest_dbh;
	if(defined($pvfile2)) {
		$dest_dbh = $dbh2;
	} else {
		$dest_dbh = $dbh;
	}
	if(!$dest_dbh->do("INSERT INTO filemaps (fileid,filename) VALUES ('$nfile_id','$nbase_file_name');")) {
		return(0,"Unable to add filemap entry for new file.");
	}
	while($cid<$onew_nv) {
		my $h1=$dbh->selectrow_hashref("SELECT * FROM versions WHERE fileid = $ofile_id AND nv = '$cid';");
		# Load in all extensions too...
		my $h2 = $dbh->selectall_hashref("SELECT * FROM exts WHERE fileid = $ofile_id and nv = '$cid';","ext");
		my @sorted=sort {int($h2->{$a}->{"ext"}) <=> int($h2->{$b}->{"ext"})} (keys(%$h2));
		for my $c_ext (@sorted) {
			$dest_dbh->do("INSERT INTO exts (fileid,nv,ext,length,data) VALUES ('$nfile_id','$cid','$h2->{$c_ext}->{ext}','$h2->{$c_ext}->{length}','$h2->{$c_ext}->{data}');");
			$rc=$dest_dbh->errstr;
			if(defined($rc)) {
				_insert_data_cleanup($dest_dbh,$nfile_id,$cid);
				return(0,$rc);
			}
		}
		$dest_dbh->do("INSERT INTO versions (fileid,nv,author,date,sha1,tags,comment,data,osize) VALUES ('$nfile_id','$cid','$h1->{author}','$h1->{date}','$h1->{sha1}','$h1->{tags}','$h1->{comment}','$h1->{data}','$h1->{osize}');");
		$rc=$dbh->errstr;
		if(defined($rc)) {
			_insert_data_cleanup($dbh,$nfile_id,$cid);
			return(0,$rc);
		}
		$cid++;
	}
	my $res=$dest_dbh->do("UPDATE versions SET tags = '' WHERE fileid = '$nfile_id';");
	$res=$dest_dbh->do("VACUUM;");
	$dbh->disconnect;
	if(defined($pvfile2)) {
		$dbh2->disconnect();
	}
	return(1,undef);
}

sub _esc($) {
my $str=$_[0];

        $str=~s/'/''/g;
        return $str;
}

#########################################################################
# This routine will take a specified FILE and PVFILE and NEWHEAD,a	#
# and will remove any any newer revisions from the PVFILE!		#
# It will also update FILE to be the new HEAD version if it is not	#
# currently writable.							#
# [RMTAGS] - A list of tags that are being removed. The new tophead	#
# version should remove any of these tags in it if they exist.		#
#									#
# Returns (1,undef) - rollback successful				#
# Returns (0,msg)   - rollback was not successful - see msg.		#
#									#
# NOTE:	IF NEWHEAD <1 THEN THE COMPLETE FILE WILL BE REMOVED!		#
#########################################################################


sub rollback {
my %args=@_;
my @rmtags=();

	if(!exists($args{FILE})) {
		return(0,"Missing mandatory 'FILE' argument");
	}
	if(!exists($args{NEWHEAD})) {
		return(0,"Missing mandatory 'NEWHEAD' argument");
	}
	my $pvfile;
	@rmtags=@{$args{RMTAGS}} if exists($args{RMTAGS});
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	#################################################################
	# Check the file can be written to - aborting if not.		#
	#################################################################

	if(! -w $pvfile) {
		return(0,"No write access to file '$pvfile'.");
	}

	my $newhead=$args{NEWHEAD};
	my $file=$args{FILE} if exists($args{FILE});
	my ($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1, AutoCommit => 0});
	if(!defined($dbh)) {
		return(0,$err_str);
	}
	my $base_file_name=basename($file);
	my ($file_id,$new_nv)=get_file_id($base_file_name,$dbh);
	

	if($newhead<1) {
		$dbh->do("DELETE FROM exts WHERE fileid = '$file_id';");
		$dbh->do("DELETE FROM versions WHERE fileid = '$file_id';");
		$dbh->commit;
		$dbh->disconnect;
	}
	# Get a list of local versions...
	my $h = $dbh->selectall_hashref("SELECT nv FROM versions WHERE fileid = '$file_id';","nv");
	my @sorted=sort {int($h->{$a}->{"nv"}) <=> int($h->{$b}->{"nv"})} (keys(%$h));
	if(! (grep {$_ == $newhead} @sorted)) {
		$dbh->disconnect();
		return(0,"Unable to find revision '$newhead'.");
	}

	#################################################################
	# We need to grab the data first at this revision. 		#
	#################################################################
	my $mydata="";
	my $rc=pv3::get(DB=>$dbh,FILE=>$base_file_name,VAR=>\$mydata,PVFILE=>$pvfile,VERSION=>$newhead);
	if($rc->[0]->[0]==0) {
		$dbh->disconnect();
		return(0,"Unable to get current version info!!",$rc->[0]->[1]);
	}
	my $ctags=$rc->[0]->[5]; $ctags="" if(!defined($ctags));
	if(@rmtags && length($ctags)) {
		my @N=();
		my @TT=split(/\|/,$ctags);
		for my $ct (@TT) {
			push @N,$ct if(! grep {$_ eq $ct} @rmtags);
		}
		$ctags=join("|",@N);
	}
	# Lets remove the extensions for this version first...
	my $res=$dbh->do("DELETE FROM exts WHERE fileid = '$file_id' AND nv = '$newhead';");
	# Now write out the new head version to versions/exts
	my $_data=encode_base64(compress($mydata));
	$res=_update_data( {
		tags	=> $ctags,
		dbh	=> $dbh,
		nv	=> $newhead,
		data	=> $_data,
		fileid	=> $file_id,
		name	=> $base_file_name,
		});
	if($res==0) {
		$dbh->rollback();
		$dbh->disconnect();
		return(0,"Unable to insert record into file.");
	}

	# Now we delete all exts and versions where nv > newhead...
	$h = $dbh->selectrow_hashref("SELECT COUNT(*) AS rc FROM versions WHERE fileid = '$file_id' AND nv > '$newhead';");
	if(!defined($h)) {
		$dbh->rollback();
		$dbh->disconnect();
		return(0,"Unable to query PV3 data file.");
	}
	if($h->{rc}>0) {
		if(!$dbh->do("DELETE FROM versions WHERE fileid = '$file_id' AND nv > '$newhead';")) {
			$dbh->rollback;
			$dbh->disconnect();
			return(0,"Unable to delete new versions.");
		}
	}

	$h = $dbh->selectrow_hashref("SELECT COUNT(*) AS rc FROM exts WHERE fileid = '$file_id' AND nv > '$newhead';");
	if(!defined($h)) {
		$dbh->rollback();
		$dbh->disconnect();
		return(0,"Unable to query PV3 data file.");
	}
	if($h->{rc}>0) {
		if(!$dbh->do("DELETE FROM exts WHERE fileid = '$file_id' AND nv > '$newhead';")) {
			$dbh->rollback;
			$dbh->disconnect();
			return(0,"Unable to delete new versions.");
		}
	}
	#################################################################
	# If we have a file then we need to get the version out 	#
	# as well ...							#
	#################################################################

	if(defined($file)) {
		if(-f $file) {
			my @s=stat(_);
			my $perms=$s[2]&07777;
			if(!rename($file,"$file.$$")) {
				$dbh->rollback;
				return (0,"Unable to rename '$file' - aborting.");
			}
		}	
		my ($rc,@x)=pv3::get(DB=>$dbh,FILE=>$file,PVFILE=>$pvfile);
		if($rc==0) {
			unlink($file);
			rename("$file.$$",$file);
			return (0,"Error occured whilst writing to '$file' - aborting.");
		}
		if(-f "$file.$$") {
			unlink("$file.$$");
		}
	}
	$dbh->commit;
	$dbh->disconnect;
	return (1,undef);
}

sub _contains_field($$$) {
my ($dbh,$obj,$field)=@_;
my ($cmd,$rc,$sth);

	$cmd="SELECT sql FROM SQLITE_MASTER WHERE type = 'table' AND name = '$obj';";
	my $h=$dbh->selectrow_hashref("$cmd");
	if(!defined($h)) {
		return -1; # table does not exist
	}
	my @F;
	if ($h->{sql} =~ /\n/) {
		@F=split(/\n/,$h->{sql});
	} else {
		my $xx=$h->{sql};
		$xx =~ s/^CREATE TABLE $obj\(//;
		$xx =~ s/\)$//;
		@F=("junk",split(/,/,$xx),"junk");
	}
	for my $cl (@F[1 .. $#F-1]) {
		my $y=$cl;
		$y =~ s/^\s+//;
		my @F2=split(/\s+/,$y);
		if(lc($F2[0]) eq lc($field)) {
			return 1; # field already exists
		}
	}
	return 0; # field does not exist
}

sub _table_field_list($$) {
my ($dbh,$table)=@_;
my ($cmd,$rc,$sth);

	$cmd="SELECT sql FROM SQLITE_MASTER WHERE type = 'table' AND name = '$table';";
	my $h=$dbh->selectrow_hashref("$cmd");
	if(!defined($h)) {
		return (0,[],[]); # table does not exist
	}
	my @F;
	if ($h->{sql} =~ /\n/) {
		@F=split(/\n/,$h->{sql});
	} else {
		my $xx=$h->{sql};
		$xx =~ s/^CREATE TABLE $table\(//;
		$xx =~ s/\)$//;
		@F=("junk",split(/,/,$xx),"junk");
	}
	my @FF=();
	my @FF2=();
	for my $cl (@F[1 .. $#F-1]) {
		my $y=$cl;
		$y =~ s/^\s+//;
		$y =~ s/,$//;
		my @YY=split(/\s+/,$y);
		push @FF,$YY[0];
		push @FF2,$YY[1];
	}
	return(1,[@FF],[@FF2]);
}

sub _get_rows($$) {
my ($dbh,$query)=@_;
my ($sth,$rc,@R,$aref);

	$sth=$dbh->prepare($query);
	if(!defined($sth)) {
		$rc=$dbh->errstr;
		return undef;
	}
	$sth->execute();
	@R=();
	while($aref  = $sth->fetchrow_hashref) {
		push @R,{%$aref};
	}
	return \@R;
}

# Returns:								#
# -1 = specified table does not exist.					#
# -2 = unable to get field definitions for table.			#
# 1  = field already present; no work required.				#
# 10+ - field added, r-10 records updated.				#

sub _add_field($$$$$) {
my ($dbh,$table,$field,$type,$value)=@_;

	my $z=_contains_field($dbh,$table,$field);
	if($z!=0) {
		return $z;
	}
	# Get the table defintiion information..

	my ($x,$r1,$r2)=_table_field_list($dbh,$table);
	if($x==0) {
		return -2;
	}
	my $cmd="create table ${table}_backup(\n";
	my $cmd2="create table ${table}(\n";
	my $ii=0;
	while($ii<@$r1) {
		$cmd2.="  $r1->[$ii] $r2->[$ii],\n";
		if($ii+1==@$r1) {
			$cmd.="  $r1->[$ii] $r2->[$ii]\n";
		} else {
			$cmd.="  $r1->[$ii] $r2->[$ii],\n";
		}
		$ii++;
	}
	$cmd.=");";
	$cmd2.="  $field $type\n);";

	$dbh->do($cmd);
	$cmd="insert into ${table}_backup SELECT " . join(",",@$r1) . " FROM $table;";
	$dbh->do($cmd);
	$cmd="DROP TABLE $table;";
	$dbh->do($cmd);
	$dbh->do($cmd2);
	# Read recrods from backup to new...
	$cmd="select * from ${table}_backup;";
	my @FLIST=(@$r1,$field);
	my $flist_txt=join(",",@FLIST);
	my $rr=_get_rows($dbh,$cmd);
	my $count=0;
	for my $crec (@$rr) {
		$crec->{$field}=$value;
		$cmd="INSERT INTO $table ($flist_txt) VALUES (";
		my $cc="";
		for my $xxx (@FLIST) {
			$cc.=",'$crec->{$xxx}'";
		}
		$cmd.=substr($cc,1) . ");";
		$dbh->do($cmd);
		$count++;
	}
	$cmd="DROP TABLE ${table}_backup;";
	$dbh->do($cmd);
	return 10+$count;
}

#########################################################################
# Passed an open database, a file id and two versions return a		#
# string with the differences between the two versions.			#
#########################################################################
{
my $diff=undef;

sub _getdiff($$$$$;$) {
my ($dbh,$fileid,$v1,$v2,$fname,$style)=@_;
$style="OldStyle" if !defined($style);

	my ($v1_ref,$v2_ref);
	if($v1 eq "_CURRENT_") {
		my ($fd,$content);
		open($fd,$fname) or return(undef,"Unable to open $fname: $!");
		$content=join("",<$fd>); close($fd);
		$v1_ref=\$content;
	} else {
		my $R=get(MEMCOPY=>1,FILE=>$fname,PVFILE=>"-",DB=>$dbh,VERSION=>$v1,FILEID=>$fileid);
		if($R->[0]->[0] == 1) {
			$v1_ref=$R->[0]->[4];
		} else {
			return(undef,$R->[0]->[1]);
		}
	}
	if($v2 eq "_CURRENT_") {
		my ($fd,$content);
		open($fd,$fname) or return(undef,"Unable to open $fname: $!");
		$content=join("",<$fd>); close($fd);
		$v2_ref=\$content;
	} else {
		my $R=get(MEMCOPY=>1,FILE=>$fname,PVFILE=>"-",DB=>$dbh,VERSION=>$v2,FILEID=>$fileid);
		if($R->[0]->[0] == 1) {
			$v2_ref=$R->[0]->[4];
		} else {
			return(undef,$R->[0]->[1]);
		}
	}

	if(!defined($v1_ref) || !defined($v2_ref)) {
		return(undef,"Missing or invalid version information.");
	}

	if($::PV3_TEXTDIFF==1) {
		my $d=Text::Diff::diff($v1_ref, $v2_ref, {STYLE => $style});
		if(!defined($d)) {
			return(undef,"Diff failed to produce results.");
		}
		return(\$d,undef);
	}

	if(defined($diff) && $diff eq "BAD") {
		return(undef,"No Text::Diff or diff command.");
	}

	if(!defined($diff)) {
		my @PATH = File::Spec->path();
		for my $cp (@PATH) {
			if(-x "$cp/diff") {
				$diff="$cp/diff";
				last;
			}
		}
		if(!defined($diff)) {
			$diff="BAD";
			return(undef,"No Text::Diff or diff command.");
		}
	}

	#################################################################
	# Dump out differences to temporary files and then run the	#
	# external diff command one them, delete them and return the	#
	# results.							#
	#################################################################

	my $fh;
	($fh,$fname)=tempfile();
	my ($fh2,$fname2)=tempfile();
	if(!defined($fh) || !defined($fh2)) {
		unlink($fname) if defined($fname);
		unlink($fname2) if defined($fname2);
		return(undef,"Unable to generate temporary file - aborting.");
	}
	if(! print $fh $$v1_ref) {
		close($fh);
		close($fh2);
		unlink($fname);
		unlink($fname2);
		return(undef,"Unable to generate temporary file - aborting.");
	}
	close($fh);
	if(! print $fh2 $$v2_ref) {
		close($fh);
		close($fh2);
		unlink($fname);
		unlink($fname2);
		return(undef,"Unable to generate temporary file - aborting.");
	}
	close($fh2);
	my $res;
	if($style ne "Context") {
		$res=`$diff $fname $fname2 2>/dev/null`;
	} else {
		$res=`$diff -c $fname $fname2 2>/dev/null`;
	}
	if($?>>8 > 1) {
		unlink($fname);
		unlink($fname2);
		return(undef,"Unable to generate differences in versions specified.");
	}
	unlink($fname);
	unlink($fname2);
	return(\$res,undef);
}

}

#########################################################################
# Given a file and a version return a list of versions that that 	#
# version onwards.A reference to a list is returned, where each 	#
# entry will be in the format as follows:				#
# -1,errmsg								#
# 0,filename,[nv list]							#
#########################################################################

sub match_version {
my %args=@_;

	$args{VERSION}=1 if !exists($args{VERSION});
	my ($dbh,$err_str);
	if(!exists($args{FILE}) || !defined($args{FILE})) {
		return [[-1,"Missing mandatory argument"]];
	}
	my $pvfile;
	if(exists($args{PVFILE})) {
		$pvfile=$args{PVFILE};
	} else {
		if(-d ".PV3") {
			$pvfile=".PV3/.pv3";
		} elsif(-d ".pv3") {
			$pvfile=".pv3/.pv3";
		} elsif(-d "PV3") {
			$pvfile="PV3/.pv3";
		} else {
			$pvfile=".pv3";
		}
	}
	if(! -e $pvfile) {
		my $cc=basename($pvfile);
		return [[-1,"No $cc file [not under code control]"]];
	}

	($dbh,$err_str)=pv_connect("dbi:SQLite:dbname=$pvfile","","",{ sqlite_handle_binary_nulls => 1});
	if(!defined($dbh)) {
		return [[-1,$err_str]];
	}

	my @files=();
	if(ref($args{FILE})) {
		@files=@{$args{FILE}};
	} else {
		@files=($args{FILE});
	}
	# If no files have been given, default to all files...
	if(! @files) {
		my $h2=$dbh->selectall_hashref("SELECT * FROM versions;","fileid");
		my $h3=$dbh->selectall_hashref("SELECT * FROM filemaps;","fileid");
		for my $cid (keys %$h2) {
			if(exists($h3->{$cid})) {
				push @files,$h3->{$cid}->{filename};
			}
		}
	}

	my @res=();
	_cache_file_id_info($dbh);
	my $set_version=0;
	_empty_versions_info();
	if(@files>100) {
		_cache_versions_info($dbh);
	}
	my $req_nv;
	for my $cfile (@files) {
		my $e;
		my $base_file_name=basename($cfile);
		# my $t1=time;
		my ($file_id,$new_nv)=get_file_id($base_file_name,$dbh,$set_version);
		if($new_nv==1) {
			push @res,[-1,"File $base_file_name is not under code control.",$base_file_name];
			next;
		}
		my $ar=get_nv_from_version($dbh,$file_id,$args{VERSION});
		if(!defined($ar->[0])) {
			push @res,[-1,$ar->[1],$base_file_name];
			next;
		} else {
			$req_nv=$ar->[0];
		}
		my @LL=();
		while($req_nv<$new_nv) {
			push @LL,$req_nv;
			$req_nv++;
		}
		push @res,[0,$base_file_name,[@LL]];
	}
	_empty_file_id_info();
	return [@res];
}

sub _bool($) {
my $v=shift;

	return(0) if !defined($v);
	$v=lc($v);
	if($v eq "true" || $v eq "yes") {
		return 1;
	}
	if($v eq "false" || $v eq "no") {
		return 0;
	}
	if($v =~ /^\d+$/) {
		return($v != 0);
	}
	return 0;
}

1;

